"
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:libbasic3' }"
Object subclass:#HTMLDocGenerator
instanceVariableNames:'outStream pathToTopOfDocumentation
pathToLanguageTopOfDocumentation httpRequestOrNil
generateBodyOnly backRef backCmd imagePath refLines demoLines
warnLines hintLines authorLines classProtocolCategories
instanceProtocolCategories'
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'
"
!
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)"
^ self new htmlClasses:classes title:title backTo:backRef
!
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
HTMLDocumentView openFullOnText:(HTMLDocGenerator htmlDocOf:Array)
"
"Modified: / 05-11-2007 / 16:19:03 / cg"
!
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:
"
!
htmlDocOfImplementorsOfAnyMatching:selectorPattern
"generate an HTML document string which contains HREFS
to all implementors of a particular selector pattern"
^ self new htmlDocOfImplementorsOfAnyMatching:selectorPattern
"
HTMLDocGenerator htmlDocOfImplementorsOfAnyMatching:'key*:x:y:'
"
!
htmlPackageDocOf:packageID
"generate an HTML document string which contains a packages classlist"
^ self new htmlPackageDocOf:packageID
"
HTMLDocGenerator htmlPackageDocOf:#'stx:libbasic'
HTMLDocumentView openFullOnText:(HTMLDocGenerator htmlPackageDocOf:#'stx:libbasic')
"
!
htmlPackageList
"generate an HTML string for all packages in the system"
^ self new htmlPackageList
"
HTMLDocGenerator htmlPackageList
"
!
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'!
findPathToTopOfDocumentation
#(
'../../doc/online'
'doc/online'
'/opt/stx/doc/online'
) do:[:eachPathToTry |
(eachPathToTry asFilename exists
and:[eachPathToTry asFilename isDirectory])
ifTrue:[
^ eachPathToTry
]
].
^ '.'
!
languageSpecificDocDirectory
|lang|
lang := UserPreferences current 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'!
generateClassInfoForClass:aClass
|owner packageID|
owner := aClass owningClass.
packageID := aClass package.
outStream nextPutLine:'<dl>'.
outStream nextPutLine:'<dt><a name="PACKAGE"><b>Package:</b></A>'.
outStream nextPutAll:'<dd><b>'.
self generatePackageDocReferenceFor:packageID text:packageID.
"/ outStream nextPutAll:packageID.
outStream nextPutLine:'</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:[
outStream nextPutLine:'</a>'.
].
outStream nextPutLine:'</td></tr></table>'.
!
generateExampleStart
outStream nextPutLine:'<p></p><table width="100%" bgcolor="#eedddd"><tr><td>'.
self generatingForSTXBrowser ifTrue:[
outStream nextPutLine:'<a info="execute the example" type="example" showresult>'.
].
outStream nextPutLine:'<pre><code>'.
!
generateExamples:examples
|inExample|
inExample := false.
outStream nextPutLine:'<h2><a name="EXAMPLES" href="#I_EXAMPLES">Examples:</A></h2>'.
outStream nextPutLine:'<BR>'.
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.
].
self generateHorizontalLine.
!
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
].
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>'
].
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>'.
!
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|
outStream nextPutAll:' '.
idx1 := ref indexOf:$:.
idx2 := ref indexOf:$: startingAt:idx1+1.
(idx1 == 0 or:[idx2 == (idx1+1)]) ifTrue:[
(ref includesMatchCharacters) ifTrue:[
outStream nextPutAll:(self
anchorForHTMLDocAction:
('htmlClassesMatching:''' , ref , ''' backTo:nil')
info:
( 'Show documentation of ' , ref )
text:
ref).
^ self
].
realRef := ref.
((ns := aClass nameSpace) notNil and:[ns ~~ Smalltalk]) ifTrue:[
ns isNameSpace ifTrue:[
(ns at:realRef asSymbol) notNil ifTrue:[
realRef := ns name , '::' , realRef
]
]
].
self generateClassDocReferenceFor:realRef text:ref.
^ self
].
(ref startsWith:'http:') ifTrue:[
outStream nextPutAll:'<a href="' , ref , '"><I>' , ref , '</I></a>'.
^ self.
].
nm := (ref copyFrom:2 to:idx1-1) withoutSpaces.
href := (ref copyFrom:(ref indexOf:$:)+1 to:(ref size - 1)) withoutSpaces.
(href startsWith:'man:') ifTrue:[
href := (href copyFrom:5) withoutSpaces.
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:[
outStream nextPutAll:'<a href="' , href , '">[<I>' , nm , '</I>]</a>'.
^ self
].
(href startsWith:'html:') ifTrue:[
href := (href copyFrom:6) withoutSpaces.
].
outStream nextPutAll:'<a href="' , (self pathToDocumentationFile:href) , '">[<I>' , nm , '</I>]</a>'.
!
generateRefLines:refLines forClass:aClass
outStream nextPutLine:'<pre>'.
refLines do:[:l |
l isString ifTrue:[
self generateRefLineFor:l forClass:aClass.
outStream cr.
] ifFalse:[
l do:[:ref |
self generateRefLineFor:ref forClass:aClass.
outStream cr.
].
].
].
outStream nextPutLine:'</pre>'.
!
generateSubclassInfoForClass:aClass
|subs|
subs := self shownSubclassesOf:aClass.
outStream nextPutLine:'<pre>'.
subs do:[:cls |
|nm|
nm := cls name.
outStream nextPutAll:' '.
cls isLoaded ifFalse:[
self
generateClassDocReferenceFor:nm
text:nm
autoloading:nm
] ifTrue:[
self generateClassDocReferenceFor:nm.
].
outStream cr.
].
outStream nextPutLine:'</pre>'.
"Modified: / 05-11-2007 / 17:22:43 / 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.
"
|docu examples wasLoaded didLoadBin
privateClasses owner shortName |
backRef := backRefArg.
backCmd := backCmdArg.
imagePath := imagePathArg.
aClass isNil ifTrue:[
^ '' "/ just in case ...
].
outStream := '' writeStream.
shortName := aClass nameWithoutPrefix.
self generateHTMLHeadWithTitle:('Class: ' , aClass name).
self generateBODYStart.
self generateBackButton.
(aClass isRealNameSpace) ifTrue:[
outStream
nextPutLine:'<h1>';
nextPutAll:'NameSpace: ';
nextPutLine:(shortName);
nextPutLine:'</h1>'.
self generateBODYandHTMLEnd.
^ outStream 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.
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:[
outStream
nextPutAll:'<a INFO="Open a Browser on ' , shortName , '" type="example" action="Smalltalk browseInClass:' , aClass name , '">';
nextPutAll:shortName; nextPutLine:'</a>'.
] ifFalse:[
outStream nextPutAll:shortName.
].
owner notNil ifTrue:[
outStream nextPutAll:' (private in '.
self generatingForSTXBrowser ifTrue:[
outStream
nextPutAll:'<a INFO="Open a Browser on ' , owner nameWithoutPrefix , '" type="example" action="Smalltalk browseInClass:' , owner name , '">';
nextPutAll:(owner nameWithoutPrefix); nextPutLine:'</a>)'.
] ifFalse:[
outStream nextPutAll:owner nameWithoutPrefix.
].
] ifFalse:[
aClass nameSpace ~~ Smalltalk ifTrue:[
outStream nextPutAll:' (in ' , aClass nameSpace name , ')'
]
].
outStream nextPutLine:'</h1>'.
owner notNil ifTrue:[
outStream nextPutLine:'This class is only visible from within'.
outStream nextPutAll:owner nameWithoutPrefix.
owner owningClass notNil ifTrue:[
outStream nextPutAll:' (which is itself a private class of '.
outStream nextPutAll:owner owningClass nameWithoutPrefix.
outStream nextPutAll:')'
].
outStream nextPutLine:'.'
].
"/
"/ index
"/
"/ s nextPutAll:'Index:'; cr.
outStream nextPutLine:'<ul>'.
outStream nextPutLine:'<li><a href="#INHERITANCE" name="I_INHERITANCE">Inheritance</a>'.
docu notNil ifTrue:[
outStream nextPutLine:'<li><a href="#DESCRIPTION" name="I_DESCRIPTION">Description</a>'.
].
warnLines notEmptyOrNil ifTrue:[
outStream nextPutLine:'<li><a href="#WARNING" name="I_WARNING">Warning</a>'.
].
hintLines notEmptyOrNil ifTrue:[
outStream nextPutLine:'<li><a href="#HINTS" name="I_HINTS">Hints</a>'.
].
refLines notNil ifTrue:[
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>'.
self generateClassProtocolDocumentationForClass:aClass.
self generateInstanceProtocolDocumentationForClass:aClass.
privateClasses notEmptyOrNil ifTrue:[
privateClasses := privateClasses asOrderedCollection sort:[:a :b | a nameWithoutPrefix < b nameWithoutPrefix].
outStream nextPutLine:'<li><a href="#PRIVATECLASSES" name="I_PRIVATECLASSES">Private classes</a>'.
].
(aClass == Object or:[aClass == Autoload]) ifTrue:[
outStream nextPutLine:'<li><a href="#SUBCLASSES" name="I_SUBCLASSES">Subclasses</a>'.
].
demoLines notNil ifTrue:[
outStream nextPutLine:'<li><a href="#DEMOSTARTUP" name="I_DEMOSTARTUP">Demonstration</a>'.
].
examples notNil ifTrue:[
outStream nextPutLine:'<li><a href="#EXAMPLES" name="I_EXAMPLES">Examples</a>'.
].
outStream nextPutLine:'</ul>'.
self generateHorizontalLine.
"/
"/ hierarchy
"/
self generateInheritanceTreeForClass:aClass.
self generateHorizontalLine.
"/
"/ category, version & package
"/
self generateClassInfoForClass:aClass.
self generateHorizontalLine.
self generateDescription:docu.
warnLines notNil ifTrue:[
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 |
outStream nextPutLine:aLine
].
outStream nextPutLine:'</pre>'.
self generateHorizontalLine.
].
hintLines notNil ifTrue:[
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 |
outStream nextPutLine:aLine
].
outStream nextPutLine:'</pre>'.
self generateHorizontalLine.
].
"/
"/ see also
"/
refLines notNil ifTrue:[
outStream nextPutLine:'<h2><a name="SEEALSO" href="#I_SEEALSO">Related information:</A></h2>'.
self generateRefLines:refLines forClass:aClass.
self generateHorizontalLine.
].
"/
"/ inst & classVars
"/ to be added
"/
"/ protocol
"/
self printOutHTMLProtocolOf:aClass on:outStream.
"/
"/ subclasses (only for Object and Autoload)
"/
(aClass == Object or:[aClass == Autoload]) ifTrue:[
outStream nextPutLine:'<h2><a name="SUBCLASSES" href="#I_SUBCLASSES">Subclasses (direct subclasses only):</A></h2>'.
self generateSubclassInfoForClass:aClass.
self generateHorizontalLine.
].
"/
"/ private classes
"/
privateClasses notEmptyOrNil ifTrue:[
outStream nextPutLine:'<h2><a name="PRIVATECLASSES" href="#I_PRIVATECLASSES">Private classes:</A></h2>'.
self generatePrivateClassInfoForClass:aClass withPrivateClasses:privateClasses.
self generateHorizontalLine.
].
"/ demonstration, if there are any
demoLines notNil ifTrue:[
self generateDemo.
self generateHorizontalLine.
].
"/ examples, if there are any
examples notNil ifTrue:[
self generateExamples:examples.
].
self generateBODYandHTMLEnd.
wasLoaded ifFalse:[
aClass unload
].
^ outStream contents
"
self htmlDocOf:Object
self htmlDocOf:Array
self htmlDocOf:Filename
self htmlDocOf:Block
"
"Created: / 24-04-1996 / 15:01:59 / cg"
"Modified: / 05-11-2007 / 17:22:54 / 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"
!
htmlDocOfImplementorsOfAnyMatching:selectorPattern
"generate an HTML document string which contains HREFS
to all implementors of a particular selector"
|s sel classes|
outStream := s := '' writeStream.
sel := self withSpecialHTMLCharactersEscaped:selectorPattern.
self generateHTMLHeadWithTitle:('Implementations of: ' , sel).
self generateBODYStart.
self generateUpArrowButtonForTop.
self generateHorizontalLine.
self generateH1:sel.
s nextPutLine:'<dl>'.
classes := IdentitySet new.
Smalltalk allClassesAndMetaclassesDo:[:cls |
cls isPrivate ifFalse:[
(cls methodDictionary keys contains:[:sel | selectorPattern match:sel]) ifTrue:[
classes add:cls
]
]
].
(classes asOrderedCollection sort:[:a :b | a name < b name])
do:[:cls |
cls methodDictionary keys do:[:eachSel |
(selectorPattern match:eachSel) ifTrue:[
self
printOutHTMLMethodProtocol:(cls compiledMethodAt:eachSel)
on:s
showClassName:true
classRef:true.
s nextPutLine:'<p>'.
].
].
].
s nextPutLine:'</dl>'.
self generateBODYandHTMLEnd.
^ s contents
! !
!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|
who := aMethod who.
sel := who methodSelector.
partStream := sel keywords readStream.
(args := aMethod methodArgNames) notNil ifTrue:[
argStream := args 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>'
].
^ methodSpecLine
"Created: / 05-11-2007 / 16:13:39 / cg"
!
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 forClass:aClass.
].
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 forClass:aClass.
].
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"
|p|
"/ p := imagePath.
"/ p isNil ifTrue:[
"/ p := self pathToTopOfDocumentation , '/icons'
"/ ].
p := self pathToTopOfDocumentation , '/pictures'.
^ self
printOutHTMLMethodProtocol:aMethod
on:aStream
showClassName:showClassName
classRef:withClassRef
picturePath:p
!
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 who methodSpecLine
firstIndent firstNonEmpty isSubres isObsolete smallOrEmpty
ballColor anchorName parseTree expr obsoleteInfo|
who := aMethod who.
cls := who methodClass.
sel := who methodSelector.
methodSpecLine := self htmlForMethod:aMethod.
"/ 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').
isObsolete := aMethod isObsolete.
"/ the above checks for the obsolete-resource flag;
"/ there is still achance for obsoleteMethodWarning to be sent, without the resource flag being present.
isObsolete ifFalse:[
((aMethod sends:'obsoleteMethodWarning' asSymbol)
or:[(aMethod sends:'obsoleteMethodWarning:' asSymbol)
or:[(aMethod sends:'obsoleteMethodWarning:from:' asSymbol)]]) ifTrue:[
(sel startsWith:'obsoleteMethodWarning') ifFalse:[
true "cls ~~ Object" ifTrue:[
isObsolete := true.
ParseTreeSearcher notNil ifTrue:[
parseTree := cls parseTreeFor:sel.
parseTree notNil ifTrue: [
expr := ParseTreeSearcher treeMatching:'`@e1 obsoleteMethodWarning:`@e2' in: parseTree.
expr isNil ifTrue:[
expr := ParseTreeSearcher treeMatching:'`@e1 obsoleteMethodWarning:`@e2 from:`@e3' in: parseTree.
].
expr notNil ifTrue:[
|arg1|
arg1 := expr arguments first.
arg1 isLiteral ifTrue:[
arg1 value isString ifTrue:[
obsoleteInfo := arg1 value.
].
].
].
].
].
].
]
].
].
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>'.
aStream nextPutAll:' '.
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>'.
obsoleteInfo notNil ifTrue:[
aStream nextPutLine:'<BR>'.
aStream nextPutLine:'<I>** ' , obsoleteInfo , ' **</I>'.
].
].
"Created: / 22-04-1996 / 20:03:30 / cg"
"Modified: / 05-11-2007 / 16:13:46 / 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"
!
undentedToFirstLinesIndent:someText
|undentedText firstIndent firstNonEmpty|
undentedText := someText.
someText size > 0 ifTrue:[
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
]
].
].
].
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"
!
htmlPackageDocOf:packageID
|classes|
classes := Smalltalk allClassesInPackage:packageID.
classes := classes reject:[:cls | cls isPrivate].
^ self htmlClasses: classes title:'Classes in package ',packageID backTo:nil
!
htmlPackageList
"generate an HTML string for a given list of selectors"
|s|
s := outStream := '' writeStream.
self generateHTMLHeadWithTitle:'Package Index'.
self generateBODYStart.
self generateUpArrowButtonForTop.
self generateHorizontalLine.
self generateH1:'Package Index'.
s nextPutLine:'<ul>'.
Smalltalk allProjectIDs
do:[:p |
|pckgString|
s nextPutAll:'<li>'.
pckgString := self withSpecialHTMLCharactersEscaped:p.
s nextPutLine:(self
anchorForHTMLDocAction:
('htmlPackageDocOf:''' , pckgString , '''' )
info:
('Classes in Package: ' , pckgString)
text:
pckgString).
].
s nextPutLine:'</ul>'.
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:'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 := self infoParameterFor: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 := self infoParameterFor: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'
"
!
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
self generateClassDocReferenceFor:className text:text autoloading:nil
!
generateClassDocReferenceFor:className text:text autoloading:autoloadedClass
"generates a link to a classes documentation"
|href serviceLinkName action|
self generatingForSTXBrowser ifFalse:[
"/ page is generated for a real http service;
"/ generate a link to the services classDocOf page,
"/ Assumes that the server has a classDoc service running.
httpRequestOrNil notNil ifTrue:[
serviceLinkName := httpRequestOrNil serviceLinkName.
].
href := self
anchorFor:(serviceLinkName, '/classDocOf,', (HTMLUtilities escape:className) )
info:('Show documentation of ' , className )
text:text
name:nil
] ifTrue:[
action := self class name , ' htmlDocOf:' , className.
autoloadedClass notNil ifTrue:[
action := autoloadedClass , ' autoload,', action.
].
href := self
anchorForHTMLAction:action
info:('Show documentation of ' , className )
text:text.
].
outStream nextPutAll: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>'.
!
generatePackageDocReferenceFor:packageID text:text
"generates a link to a package documentation"
|href serviceLinkName action|
self generatingForSTXBrowser ifFalse:[
"/ page is generated for a real http service;
"/ generate a link to the services packageDocOf page,
"/ Assumes that the server has a classDoc service running.
httpRequestOrNil notNil ifTrue:[
serviceLinkName := httpRequestOrNil serviceLinkName.
].
href := self
anchorFor:(serviceLinkName, '/classListForPackage,', (HTMLUtilities escape:packageID) )
info:('Show documentation of package ' , packageID )
text:text
name:nil
] ifTrue:[
action := self class name , ' htmlPackageDocOf: #''' , packageID, ''''.
href := self
anchorForHTMLAction:action
info:('Show documentation of package ' , packageID )
text:text.
].
outStream nextPutAll:href.
!
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 class="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 src="' , p , '/DocsUpArrow.gif" alt="[' , (altLabel ? 'back') , ']"></a>'.
!
generatingForSTXBrowser
^ httpRequestOrNil isNil
!
infoParameterFor:infoMessageOrNil
infoMessageOrNil isNil ifTrue:[^ ''].
^
'ONMOUSEOVER="window.status=''',infoMessageOrNil,'''; return true" ' ,
'ONMOUSEOUT="window.status='' ''; return true" '
!
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:[
aMethod messagesSent isEmpty ifTrue:[
parseTree := mClass parseTreeFor:mSel.
parseTree notNil ifTrue: [
(mClass allInstanceVariableNames) do:[:eachVar |
matcher := ParseTreeSearcher getterMethod:eachVar.
(matcher executeTree: parseTree initialAnswer:false) ifTrue:[
^ 'Return the instance variable ' , eachVar, '.'.
].
matcher := ParseTreeSearcher setterMethod:eachVar.
(matcher executeTree: parseTree initialAnswer:false) 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>'.
!
shownSubclassesOf:aClass
|subs|
subs := aClass subclasses.
subs := subs select:[:cls | |def|
def := cls projectDefinitionClass.
def isNil or:[def showClassDocumentationOf:cls]].
subs := subs asOrderedCollection sort:[:a :b | a name < b name].
^ subs
"Created: / 05-11-2007 / 17:22:27 / cg"
!
withSpecialHTMLCharactersEscaped:aStringOrCharacter
^ HTMLUtilities withSpecialHTMLCharactersEscaped:aStringOrCharacter
"
self new withSpecialHTMLCharactersEscaped:'foo>'
self new withSpecialHTMLCharactersEscaped:$<
self new withSpecialHTMLCharactersEscaped:$A
"
! !
!HTMLDocGenerator methodsFor:'pathnames'!
findPathToTopOfDocumentation
^ self class findPathToTopOfDocumentation
!
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.91 2009-10-10 12:54:28 cg Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/libbasic3/HTMLDocGenerator.st,v 1.91 2009-10-10 12:54:28 cg Exp $'
! !