#OTHER by cg
class: FileBasedSourceCodeManager class
removed: #version_FileRepository
"{ Encoding: utf8 }"
"
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' }"
"{ NameSpace: Smalltalk }"
Object subclass:#HTMLDocGenerator
instanceVariableNames:'outStream pathToTopOfDocumentation
pathToLanguageTopOfDocumentation httpRequestOrNil
generateBodyOnly backRef backCmd imagePath refLines demoLines
warnLines hintLines authorLines classProtocolCategories
instanceProtocolCategories generateJavaScriptCallInfo
generateDocumentForOfflineReading showUpButton'
classVariableNames:'CachedKWIC'
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.
This is used with the SystemBrowser (classes-generate documentation menu),
and the online documentation (which generates up-to-date documents just-in-time
out of the running system).
It may also be useful, to programatically generate up-to-date documents
into a folder of self contained html files (eg. for deployment).
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.
[instance variables:]
outStream <WriteStream> internal
pathToTopOfDocumentation <String> will be prepended to links.
defaults to '../../doc'
pathToLanguageTopOfDocumentation <String> defaults to '../../doc/online/<lang>'
httpRequestOrNil internal
generateBodyOnly internal
backRef <URLString> if non-nil, the url for a back-button
backCmd <String> if non-nil, the command for a back-button (for internal doc-browser only)
imagePath <String> path to image documents
refLines internal
demoLines internal
warnLines internal
hintLines internal
authorLines internal
classProtocolCategories internal
instanceProtocolCategories internal
generateJavaScriptCallInfo <Boolean> if true, synopsis is shown in JavaScript syntax also
generateDocumentForOfflineReading <Boolean> if true, document is generated with file links (instead of browser command links)
for offline reading by an arbitrary browser.
[author:]
Claus Gittinger
[see also:]
BrowserView
HTMLDocumentView
"
! !
!HTMLDocGenerator class methodsFor:'document generation'!
generateOfflineDocIn:aTopDirectory
"generate a full tree of documents for offline reading.
Similar to what is generated by the live-document generator, but
all links are to static files.
Tool for deployment."
aTopDirectory recursiveMakeDirectory.
(aTopDirectory / 'packages') recursiveMakeDirectory.
(aTopDirectory / 'categories') recursiveMakeDirectory.
(aTopDirectory / 'index.html') contents:(self htmlOfflineIndex).
(aTopDirectory / 'packages/index.html') contents:(self htmlOfflinePackageList).
(aTopDirectory / 'categories/index.html') contents:(self htmlOfflineClassCategoryList).
"/ (aTopDirectory / 'classes/index.html') contents:(self htmlOfflineClassList).
"
self generateOfflineDocIn:'./offlineDoc' asFilename
"
!
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:'
"
!
htmlKWOCList
"
CachedKWIC := nil
"
CachedKWIC isNil ifTrue:[
"/ CachedKWIC := self generateKWIC.
CachedKWIC := self generateKWICForClassAndMethodNames.
"/ to flush the cached kwic, whenever a class-documentation method is changed
Smalltalk addDependent:self class.
].
^ self new htmlKWOCListFor:CachedKWIC
"
HTMLDocGenerator htmlKWOCList
"
!
htmlOfflineClassCategoryList
"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
generateDocumentForOfflineReading:true;
htmlClassCategoryList
"
HTMLDocGenerator htmlOfflineClassCategoryList
"
!
htmlOfflineDocOf:aClass
"generate an HTML document string which contains a class's documentation for offline reading.
This is different in that it creates file links, instead of action links
(action links only work with the builtin doc reader)."
^ self new htmlOfflineDocOf:aClass
"
HTMLDocGenerator htmlDocOf:Array
HTMLDocumentView openFullOnText:(HTMLDocGenerator htmlDocOf:Array)
"
"Modified: / 05-11-2007 / 16:19:03 / cg"
!
htmlOfflineIndex
^ '<html>
<body>
<ul>
<li><A HREF="packages/index.html">By Package</A>
<li><A HREF="categories/index.html">By Category</A>
<li><A HREF="classes/index.html">By Class Name</A>
</ul>
</body>
</html>
'
!
htmlOfflinePackageList
"generate an HTML string for all packages in the system"
^ self new
generateDocumentForOfflineReading:true;
htmlPackageList
"
HTMLDocGenerator htmlOfflinePackageList
"
!
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:'document generation-helpers'!
camelCaseSeparatedWordsOf:wordIn do:aBlock
"
self camelCaseSeparatedWordsOf:'HelloWorld' do:[:w | Transcript showCR:w]
self camelCaseSeparatedWordsOf:'abcDef' do:[:w | Transcript showCR:w]
self camelCaseSeparatedWordsOf:'UTFEncoder' do:[:w | Transcript showCR:w]
self camelCaseSeparatedWordsOf:'JisEncoder' do:[:w | Transcript showCR:w]
self camelCaseSeparatedWordsOf:'JISEncode' do:[:w | Transcript showCR:w]
"
|state newState in out ch part|
in := wordIn readStream.
out := '' writeStream.
[in atEnd] whileFalse:[
ch := in next.
(ch isDigit or:[ch == $_]) ifFalse:[
newState := ch isUppercase.
].
(newState ~~ state) ifTrue:[
newState == true ifTrue:[
"/ going from lower- to uppercase
part := out contents.
part notEmpty ifTrue:[ aBlock value:part ].
out := '' writeStream.
out nextPut:ch.
state := newState.
] ifFalse:[
"/ going upper- to lowercase
out size <= 1 ifTrue:[
out nextPut:ch.
] ifFalse:[
|prev|
prev := out contents.
aBlock value:(prev copyButLast).
out := '' writeStream.
out nextPut:prev last.
out nextPut:ch.
].
state := newState.
].
] ifFalse:[
out nextPut:ch.
].
].
part := out contents.
part notEmpty ifTrue:[ aBlock value:part ].
!
generateKWIC
|fillWords kwic|
fillWords :=
#(
'the' 'a'
'can' 'you'
'to' 'in' 'out' 'at' 'of'
'also' 'with' 'without' 'all' 'any' 'how'
'however' 'although' 'always' 'either' 'neither'
'anywhere' 'anyway' 'anything' 'anyone'
'not' 'but' 'else' 'elsewhere'
'am' 'are' 'is' 'be' 'will' 'wont' 'won''t' 'do' 'don''t'
'no' 'non' 'now' 'old' 'on' 'only'
'my' 'their' 'your' 'its'
'one' 'two' 'three'
'etc' 'for' 'lot' 'lots' 'made' 'may' 'most' 'mostly' 'much'
'use' 'this' 'that' 'which' 'what' 'why'
'or' 'other' 'please'
).
kwic := KeywordInContextIndexBuilder new.
kwic excluded:fillWords.
kwic separatorAlgorithm:[:line |
line asCollectionOfSubstringsSeparatedByAny:' ^~=@.:,;-+*/()[]|{}#"''<>',Character cr
].
kwic exclusionFilter:[:word |
word size == 1
or:[ word conform:#isDigit ]].
Smalltalk allClassesDo:[:eachClass |
eachClass isLoaded ifTrue:[
|doc|
doc := eachClass commentOrDocumentationString.
doc notEmptyOrNil ifTrue:[
kwic addLine:doc reference:eachClass ignoreCase:true.
].
].
].
"/ if we have a key like 'startWith:' in the list,
"/ and 'starts' is also there, place the 'startsWith:' entries into the same bin.
kwic remapKeywordsWith:[:oldKey :knownMappings |
|newKey|
6 to:oldKey size - 1 do:[:len |
newKey isNil ifTrue:[
|part|
part := (oldKey copyTo:len).
(knownMappings includes:part) ifTrue:[
newKey := part.
].
].
].
newKey ? oldKey.
].
^ kwic
"
CachedKWIC := nil.
self generateKWIC
"
!
generateKWICForClassAndMethodNames
|fillWords kwic|
fillWords :=
#(
"/ 'the' 'a'
"/ 'can' 'you'
"/ 'to' 'in' 'out' 'at' 'of'
"/ 'also' 'with' 'without' 'all' 'any' 'how'
"/ 'however' 'although' 'always' 'either' 'neither'
"/ 'anywhere' 'anyway' 'anything' 'anyone'
"/ 'not' 'but' 'else' 'elsewhere'
"/ 'am' 'are' 'is' 'be' 'will' 'wont' 'won''t' 'do' 'don''t'
"/ 'no' 'non' 'now' 'old' 'on' 'only'
"/ 'my' 'their' 'your' 'its'
"/ 'one' 'two' 'three'
"/ 'etc' 'for' 'lot' 'lots' 'made' 'may' 'most' 'mostly' 'much'
"/ 'use' 'this' 'that' 'which' 'what' 'why'
"/ 'or' 'other' 'please'
).
kwic := KeywordInContextIndexBuilder new.
kwic excluded:fillWords.
kwic separatorAlgorithm:[:name |
|words|
words := Set new.
(name asCollectionOfSubstringsSeparatedBy:$:) do:[:eachPart |
eachPart notEmpty ifTrue:[
self camelCaseSeparatedWordsOf:eachPart do:[:w | words add:w].
].
].
words := words reject:[:w | w isEmpty].
words
].
Smalltalk allClassesDo:[:eachClass |
kwic addLine:eachClass name reference:eachClass ignoreCase:true.
"/ eachClass isLoaded ifTrue:[
"/ eachClass theNonMetaclass selectorsAndMethodsDo:[:sel :mthd |
"/ kwic addLine:sel reference:mthd ignoreCase:true.
"/ ].
"/ eachClass theMetaclass selectorsAndMethodsDo:[:sel :mthd|
"/ kwic addLine:sel reference:mthd ignoreCase:true.
"/ ].
"/ ].
].
^ kwic
"
CachedKWIC := nil.
self generateKWICForClassAndMethodNames
"
!
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"
! !
!HTMLDocGenerator class methodsFor:'pathnames'!
findPathToTopOfDocumentation
"find the 'doc/online' folder"
|triedDirs|
triedDirs := OrderedCollection new.
triedDirs add:(Smalltalk packageDirectory directory / 'doc/online') pathName.
triedDirs addAll:
#(
'../../doc/online'
'doc/online'
'/opt/stx/doc/online'
).
triedDirs do:[:eachPathToTry |
(eachPathToTry asFilename exists
and:[eachPathToTry asFilename isDirectory])
ifTrue:[
^ eachPathToTry
]
].
^ '.'
"
self findPathToTopOfDocumentation
"
"Modified (comment): / 25-11-2017 / 14:05:08 / cg"
!
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 == #es ifTrue:[
"/ ^ 'spanish'.
"/ ].
lang == #jp ifTrue:[
^ 'japanese'.
].
^ 'english'.
"
self languageSpecificDocDirectory
"
! !
!HTMLDocGenerator methodsFor:'accessing'!
generateBodyOnly:aBoolean
generateBodyOnly := aBoolean.
!
generateDocumentForOfflineReading
^ generateDocumentForOfflineReading ? false
!
generateDocumentForOfflineReading:aBoolean
generateDocumentForOfflineReading := aBoolean.
!
generateJavaScriptCallInfo
^ generateJavaScriptCallInfo ? false
!
generateJavaScriptCallInfo:aBoolean
generateJavaScriptCallInfo := aBoolean.
!
httpRequest:aRequest
httpRequestOrNil := aRequest.
!
pathToLanguageTopOfDocumentation:something
pathToLanguageTopOfDocumentation := something.
!
pathToTopOfDocumentation:something
pathToTopOfDocumentation := something.
!
showUpButton
^ showUpButton ? true
!
showUpButton:aBoolean
showUpButton := aBoolean
! !
!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 nextPutAll:'</code></pre>'.
self generatingForSTXBrowser ifTrue:[
outStream nextPutAll:'</a>'.
].
outStream nextPutAll:'</td></tr></table>'.
!
generateExampleStart
"/ outStream nextPutAll:'<p></p>'.
outStream nextPutAll:'<table width="100%" bgcolor="#eedddd"><tr><td>'.
self generatingForSTXBrowser ifTrue:[
outStream nextPutLine:'<a info="execute the example" type="example" showresult>'.
].
outStream nextPutAll:'<pre><code>'.
!
generateExamples:examples
"everything between exBegin and exEnd is shown as code example;
the remaining text is shown as regular text (commenting the code, I hope)"
|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"
! !
!HTMLDocGenerator methodsFor:'document generation-API'!
htmlDocOf:aClass
"generate an HTML document string which contains a classes documentation"
^ self htmlDocOf:aClass theNonMetaclass 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 ownerName 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:[
ownerName := owner nameWithoutPrefix.
outStream nextPutAll:' (private in '.
self generatingForSTXBrowser ifTrue:[
outStream
nextPutAll:'<a INFO="Open a Browser on ' , ownerName , '" type="example" action="Smalltalk browseInClass:' , owner name , '">';
nextPutAll:(ownerName); nextPutLine:'</a>)'.
] ifFalse:[
outStream nextPutAll:ownerName.
].
] 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:ownerName.
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.
outStream nextPutAllLines:warnLines.
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.
outStream nextPutAllLines:hintLines.
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: / 27-07-2012 / 09:29:45 / 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
!
htmlOfflineDocOf:aClass
"generate an HTML document string which contains a class's documentation for offline reading.
Offline reading means that the links to other classes are created as file links,
(as opposed to action links, which only work with the builtin doc reader)."
generateDocumentForOfflineReading := true.
^ self
htmlDocOf:aClass back:nil backRef:nil
imagePath:(self pathToTopOfDocumentation , '/icons')
"
self htmlOfflineDocOf:PostscriptPrinterStream
"
! !
!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 notEmpty and:[examples first isEmptyOrNil]] whileTrue:[
examples removeFirst.
].
[examples notEmpty and:[examples last isEmptyOrNil]] whileTrue:[
examples removeLast.
].
examples isEmpty ifTrue:[ ^ nil].
examples := self undentedToFirstLinesIndent:examples.
^ examples
!
extractProtocolCategoriesFrom:aClass
classProtocolCategories := aClass theMetaclass methodCategories asSortedCollection.
classProtocolCategories notEmpty ifTrue:[
classProtocolCategories := classProtocolCategories asSortedCollection.
classProtocolCategories remove:'documentation' ifAbsent:nil.
].
instanceProtocolCategories := aClass theNonMetaclass methodCategories asSortedCollection.
instanceProtocolCategories notEmpty ifTrue:[
instanceProtocolCategories := instanceProtocolCategories asSortedCollection.
].
"Modified: / 05-07-2017 / 10:51:25 / cg"
!
htmlForMethod:arg
^ self class htmlForMethod:arg
!
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 method's message specification
and any method comments - without source; used to generate documentation
pages"
^ self
printOutHTMLMethodProtocol:aMethod
on:aStream
showClassName:false
classRef:false
"Modified: / 22-04-1996 / 18:01:56 / cg"
"Created: / 22-04-1996 / 20:03:30 / cg"
"Modified (comment): / 21-11-2017 / 13:01:48 / cg"
!
printOutHTMLMethodProtocol:aMethod on:aStream showClassName:showClassName classRef:withClassRef
"given the source in aString, print the method's 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
"Modified (comment): / 21-11-2017 / 13:01:53 / cg"
!
printOutHTMLMethodProtocol:aMethod on:aStream showClassName:showClassName classRef:withClassRef picturePath:picturePath
"given the source in aString, print the method's 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
exampleComments isInheritedComment|
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 isSubclassResponsibility.
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 sendsAnySelector:#(#'obsoleteMethodWarning' #'obsoleteMethodWarning:' #'obsoleteMethodWarning:from:')) 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'.
]
]
].
aMethod isExtension ifTrue:[
methodSpecLine := methodSpecLine,(' <br>( <i>an extension from the %1 package</i> )' bindWith:aMethod package).
].
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>'.
self generateJavaScriptCallInfo ifTrue:[
|jsMethodSpecLine|
aStream nextPutLine:'<br>JS: ' , (HTMLDocGeneratorForJavaScript htmlForMethod:aMethod).
].
].
aStream nextPutLine:'<DD>'.
isInheritedComment := false.
comment := self methodCommentOf:aMethod.
"/ filter history lines
((comment startsWith:'Created: ')
or:[ (comment startsWith:'Modified: ') ]) ifTrue:[
comment := nil.
].
comment isEmptyOrNil ifTrue:[
|m|
m := aMethod mclass superclass lookupMethodFor:aMethod selector.
m notNil ifTrue:[
(comment := self methodCommentOf:m) notEmptyOrNil ifTrue:[
isInheritedComment := true.
((comment startsWith:'Created: ')
or:[ (comment startsWith:'Modified: ') ]) ifTrue:[
comment := nil.
].
].
].
].
comment 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.
isInheritedComment ifTrue:[
comment := '<I>(comment from inherited method)</I><BR>' , comment.
].
"/ make argument names italic in the comment
aMethod numArgs > 0 ifTrue:[
(aMethod methodArgNames ? #()) do:[:each |
comment := comment copyReplaceString:each withString:'<I>',each,'</I>'
].
comment := comment copyReplaceString:'<I><I>' withString:'<I>'.
comment := comment copyReplaceString:'</I></I>' withString:'</I>'.
].
].
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>'.
].
].
(isSubres | isObsolete) ifFalse:[
[
exampleComments := self methodExampleCommentsOf:aMethod.
] valueWithTimeout:10 seconds.
exampleComments notEmptyOrNil ifTrue:[
exampleComments do:[:each |
|exampleCode|
exampleCode := self undentedToFirstLinesIndent:each asStringCollection.
[exampleCode size > 0 and:[(exampleCode first ? '') withoutSeparators isEmpty]]
whileTrue:[ exampleCode removeFirst].
[exampleCode size > 0 and:[(exampleCode last ? '') withoutSeparators isEmpty]]
whileTrue:[ exampleCode removeLast].
exampleCode notEmpty ifTrue:[
"/ outStream nextPutLine:'<blockquote>'.
outStream nextPutLine:'<p>usage example(s):'.
"/ outStream nextPutLine:'usage example(s):<br>'.
self generateExampleStart.
exampleCode do:[:eachLine |
outStream nextPutLine:eachLine
].
self generateExampleEnd.
"/ outStream nextPutLine:'</blockquote>'.
].
].
].
].
"
self basicNew
printOutHTMLMethodProtocol:(Array compiledMethodAt:#addAllNonNilElementsTo:)
on:Transcript
showClassName:true classRef:true picturePath:'pics'
"
"Created: / 22-04-1996 / 20:03:30 / cg"
"Modified: / 16-07-2017 / 11:28:18 / cg"
"Modified: / 13-06-2018 / 10:56:43 / Claus Gittinger"
!
printOutHTMLProtocolOf:aClass on:aStream
"append documentation of the given class in HTML onto aStream."
|collectionOfCategories any|
"/ self printOutDefinitionOn:aPrintStream.
collectionOfCategories := aClass class methodCategories 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 methodCategories 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-04-1996 / 20:03:30 / cg"
"Modified: / 05-07-2017 / 10:51:39 / 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 copyButLast: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>'.
self generateDocumentForOfflineReading ifTrue:[
s nextPutLine:(self
anchorFor:
((nm copyReplaceAll:$ with:$_) , '/index.html' )
info:
('Classes in ' , nm)
text:
(nm copyFrom:prefix size + 1)
name:nil).
] ifFalse:[
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"
!
htmlKWOCListFor:aKWIC
"generate a formatted list of all keywords in context from class documentation
as an HTML string.
Each keword will be a hyperlinked to another
autogenerated page, containing the classes documentation.
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)"
|prevWord caseMapping|
outStream := '' writeStream.
self generateHTMLHeadWithTitle:'Keyword Index:'.
self generateBODYStart.
self generateUpArrowButtonForTop.
self generateHorizontalLine.
self generateH1:'Keywords:'.
outStream nextPutLine:'<dl>'.
prevWord := nil.
caseMapping := Dictionary new.
aKWIC entriesDo:[:word :left :right :class|
|lcWord wordAlready|
lcWord := word asLowercase.
lcWord ~= word ifTrue:[
wordAlready := caseMapping at:lcWord ifAbsent:[nil].
wordAlready isNil ifTrue:[
caseMapping at:lcWord put:word
].
].
].
aKWIC matchSorter:[:a :b | a key < b key].
aKWIC entriesDo:[:word :left :right :classOrMethod|
|ref lcWord ctx|
ctx := (HTMLUtilities escapeCharacterEntities:(left contractAtBeginningTo:25))
, ' <b>',(HTMLUtilities escapeCharacterEntities:word),'</b> '
,(HTMLUtilities escapeCharacterEntities:(right contractAtEndTo:25)).
lcWord := word asLowercase.
lcWord ~= prevWord ifTrue:[
prevWord notNil ifTrue:[
outStream nextPutLine:'</ul></dd>'.
].
"/ outStream nextPutLine:'<dt>',(HTMLUtilities escapeCharacterEntities:(caseMapping at:lcWord ifAbsent:[word])),'</dt>'.
outStream nextPutLine:'<dt>',(HTMLUtilities escapeCharacterEntities:word),'</dt>'.
outStream nextPutLine:'<dd><ul><li>'.
classOrMethod isBehavior ifTrue:[
self generateClassDocReferenceFor:classOrMethod name.
] ifFalse:[
self generateMethodDocReferenceFor:classOrMethod selector inClass:classOrMethod mclass name text:classOrMethod selector autoloading:nil.
].
outStream nextPutAll:'<tab indent=300>'.
outStream nextPutLine:ctx.
outStream nextPutLine:'</li>'.
prevWord := lcWord.
] ifFalse:[
outStream nextPutLine:'</li><li>'.
classOrMethod isBehavior ifTrue:[
self generateClassDocReferenceFor:classOrMethod name.
] ifFalse:[
self generateMethodDocReferenceFor:classOrMethod selector inClass:classOrMethod mclass name text:classOrMethod selector autoloading:nil.
].
outStream nextPutAll:'<tab indent=300>'.
outStream nextPutLine:ctx.
outStream nextPutLine:'</li>'.
].
].
outStream nextPutLine:'</ul></dd>'.
outStream nextPutLine:'</dl>'.
self generateBODYandHTMLEnd.
^ outStream contents
!
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 list of all packages in the system"
^ self
htmlPackageListFor:(Smalltalk allPackageIDs)
withDocumentation:true "/ false
"
self new
generateDocumentForOfflineReading:true;
htmlPackageList.
"
!
htmlPackageListFor:packageNames withDocumentation:withDocumentation
"generate an HTML string for a given list of packages"
|s|
s := outStream := '' writeStream.
self generateHTMLHeadWithTitle:'Package Index'.
self generateBODYStart.
self generateUpArrowButtonForTop.
self generateHorizontalLine.
self generateH1:'Package Index'.
s nextPutLine:'<ul>'.
packageNames
do:[:p |
|pckgString|
(p startsWith:'__') ifFalse:[
s nextPutAll:'<li>'.
pckgString := self withSpecialHTMLCharactersEscaped:p.
self generateDocumentForOfflineReading ifTrue:[
s nextPutLine:(self
anchorFor:
((p copyReplaceAll:$: with:$/) , '/index.html' )
info:
('Classes in Package: ' , pckgString)
text:
pckgString
name:nil).
] ifFalse:[
s nextPutLine:(self
anchorForHTMLDocAction:
('htmlPackageDocOf:''' , pckgString , '''' )
info:
('Classes in Package: ' , pckgString)
text:
pckgString).
].
].
].
s nextPutLine:'</ul>'.
self generateBODYandHTMLEnd.
^ s contents
"
self new
generateDocumentForOfflineReading:true;
htmlPackageList.
"
!
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 selectorsDo:[:sel |
(pattern match:sel) ifTrue:[
selectors add:sel.
]
]
].
selectors := selectors asOrderedCollection sort.
^ self
htmlSelectors:selectors
title:('Selectors matching ''' , pattern , ''':').
"
self htmlSelectorListMatching:'*do*'
"
"Created: / 22-04-1996 / 20:03:31 / cg"
"Modified: / 05-06-1996 / 12:29:27 / stefan"
"Modified: / 10-02-2017 / 10:32:37 / 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 selectorsDo:[: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-04-1996 / 20:03:31 / cg"
"Modified: / 05-06-1996 / 12:31:13 / stefan"
"Modified: / 10-02-2017 / 10:32:31 / 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 abortAndClose.
]
].
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 isNil 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'
"
!
findPathToTopOfDocumentation
<resource: #obsolete>
^ self class findPathToTopOfDocumentation
!
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 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.
] 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
].
outStream nextPutAll:href.
!
generateH1:headerLine
outStream nextPutLine:'<h1>'.
outStream nextPutLine:headerLine.
outStream nextPutLine:'</h1>'.
!
generateHTMLEnd
generateBodyOnly == true ifFalse:[
outStream nextPutLine:'</html>'
]
!
generateHTMLHeadWithTitle:title
|generatedByComment|
generatedByComment := ('<!!-- generated by ' , self class name , ' ' , thisContext sender selector , ' -->').
generateBodyOnly == true ifFalse:[
outStream
nextPutLine:'<!!DOCTYPE html PUBLIC "-//w3c//dtd html 4.0 transitional//en">';
nextPutLine:generatedByComment;
cr;
nextPutLine:'<html>';
nextPutLine:'<head>';
nextPutLine:'<title>';
nextPutLine:title;
nextPutLine:'</title>';
nextPutLine:'</head>';
cr.
] ifTrue:[
outStream
nextPutLine:generatedByComment
].
!
generateHorizontalLine
outStream nextPutLine:'<hr>'.
!
generateMethodDocReferenceFor:selector inClass:className text:text autoloading:autoloadedClass
"generates a link to a classes documentation"
|href serviceLinkName action|
self generatingForSTXBrowser 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.
] 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
].
outStream nextPutAll:href.
!
generatePackageDocReferenceFor:packageID text:text
"generates a link to a package documentation"
|href serviceLinkName action|
self generatingForSTXBrowser ifFalse:[
self generateDocumentForOfflineReading ifTrue:[
href := self
anchorFor:(pathToTopOfDocumentation, '/packages/', (HTMLUtilities escape:packageID) )
info:('Show documentation of package ' , packageID )
text:text
name:nil
] 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
|top|
self generateDocumentForOfflineReading ifTrue:[
top := '../index.html'.
] ifFalse:[
top := (self pathToLanguageTopOfDocumentation , '/TOP.html').
].
self
generateUpArrowButtonWithReference:top
command:nil
imagePath:nil
altLabel:'top'
!
generateUpArrowButtonWithReference:backHRef command:backCmd imagePath:imagePath altLabel:altLabel
|p|
self showUpButton ifFalse:[^ self].
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
self generateDocumentForOfflineReading ifTrue:[^ false].
^ httpRequestOrNil isNil
!
infoParameterFor:infoMessageOrNil
infoMessageOrNil isNil ifTrue:[^ ''].
^
'ONMOUSEOVER="window.status=''',infoMessageOrNil,'''; return true" ' ,
'ONMOUSEOUT="window.status='' ''; return true" '
!
methodCommentOf:aMethod
"extract the very first comment from the method"
|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 it's 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.
"Modified (comment): / 13-02-2017 / 20:21:50 / cg"
!
methodExampleCommentsOf:aMethod
"extract the very last comment from the method"
|comments partOfSelector|
comments := aMethod parserClass methodCommentsFromSource:aMethod source.
comments size <= 1 ifTrue:[^ nil].
"/ look for comments which make up valid source code in the method's language
partOfSelector := aMethod selector.
(partOfSelector includes:$:) ifTrue:[
partOfSelector := partOfSelector copyTo:(partOfSelector indexOf:$:)
].
comments := (comments from:2)
select:[:each |
(each includesString:partOfSelector)
and:[
|rslt|
rslt := [ aMethod parserClass parseExpression:each ] on:Error do:#Error.
rslt ~~ #Error.
].
].
^ comments.
!
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
|string|
string := aStringOrCharacter isString ifTrue:[aStringOrCharacter] ifFalse:[aStringOrCharacter asString].
^ HTMLUtilities escapeCharacterEntities:string
"
self new withSpecialHTMLCharactersEscaped:'foo>'
self new withSpecialHTMLCharactersEscaped:$<
self new withSpecialHTMLCharactersEscaped:$A
"
"Modified: / 13-04-2011 / 23:11:16 / cg"
! !
!HTMLDocGenerator methodsFor:'pathnames'!
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 class findPathToTopOfDocumentation
].
^ pathToTopOfDocumentation
! !
!HTMLDocGenerator class methodsFor:'documentation'!
version
^ '$Header$'
!
version_CVS
^ '$Header$'
! !