"
COPYRIGHT (c) 1996 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
"{ Package: 'stx:libhtml' }"
Object subclass:#HTMLDocGenerator
instanceVariableNames:''
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)"
|categories s prefixList prefix prefixStack prev|
categories := Set new.
Smalltalk allClasses do:[:cls |
cls isPrivate ifFalse:[
(cls isNameSpace not or:[cls == Smalltalk]) ifTrue:[
categories add:cls category
]
]
].
categories := categories asOrderedCollection sort.
s := '' writeStream.
s nextPutAll:'
<html>
<head>
<title>
Class categories:
</title>
</head>
<body>
<a NOPRINT HREF="TOP.html"> <IMG SRC="../icons/DocsUpArrow.gif" ALT="[back]"></A>
<hr>
<h1>Class categories:</h1>
<ul>
'.
prefixList := Set new.
categories keysAndValuesDo:[:index :element |
|prev common|
index ~~ 1 ifTrue:[
prev := categories at:(index - 1).
common := (Array with:prev with:element) longestCommonPrefix.
(common endsWith:'-') ifTrue:[
prefixList add:(common copyWithoutLast:1)
] ifFalse:[
(common 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 |
nm = prefix ifTrue:[
maxPrefix
] ifFalse:[
(nm startsWith:prefix)
ifTrue:[
prefix size > maxPrefix size
ifTrue:[
prefix
] ifFalse:[
maxPrefix
]
] ifFalse:[
maxPrefix
]
]
].
longest size > 0 ifTrue:[
longest = prefix ifTrue:[
"/ no change
] ifFalse:[
(longest startsWith:prefix) ifTrue:[
prefixStack addLast:longest.
longest ~= prev ifTrue:[
prefixStack size == 1 ifTrue:[
s nextPutLine:'<p>'.
].
s nextPutLine:'<li>' , longest.
].
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><a href="../misc/onlyInSTX2.html" action="html:'
, self name
, ' htmlClassesListOfCategory:''' , nm
, ''' backTo:''htmlClassCategoryList''">'
"/ full name:
"/ , nm ,'</a>';cr.
"/ cut off prefix:
, (nm copyFrom:prefix size + 1) ,'</a>';cr.
prev := nm.
].
s nextPutAll:'
</ul>
</body>
</html>
'.
^ s contents
"
HTMLDocGenerator htmlClassCategoryList
"
"Created: / 22.4.1996 / 20:03:30 / cg"
"Modified: / 30.10.1997 / 13:16:08 / cg"
!
htmlClassListPrefix:prefix
"generate an HTML document string which contains HREFS for a list
of classes which start with some prefix (typically, the first
character is given)"
|classes|
classes := Smalltalk allClasses
select:[:cls |
cls isPrivate not
and:[(cls isNameSpace not or:[cls == Smalltalk])
and:[cls name startsWith:prefix]]
].
^ self
htmlClasses:classes
title:('Classes starting with ''' , prefix asString , ''':').
"Created: / 22.4.1996 / 20:03:31 / cg"
"Modified: / 30.10.1997 / 13:21:49 / cg"
!
htmlClasses:classes title:title
"generate an HTML document string which contains HREFS for a given list
of classes"
^ self
htmlClasses:classes
title:title
backTo:nil
"Modified: / 30.10.1997 / 13:21:40 / cg"
!
htmlClasses:classes title:title backTo:backRef
"generate an HTML document string which contains HREFS for a given list
of classes. If backref is nonNil, a back-button to that
HREF is added at the top.
The generated page is supposed to be given to an HTML reader
with home being set to ../doc/online/xxx/classDoc
(i.e. the images are to be found one-up in the doc hierarchy)"
|classNames s|
classNames := (classes collect:[:cls | cls name]) asOrderedCollection sort.
s := '' writeStream.
s nextPutAll:'
<html>
<head>
<title>
'.
s nextPutAll:title.
s nextPutAll:'
</title>
</head>
<body>
'.
backRef notNil ifTrue:[
backRef == #none ifFalse:[
s nextPutAll:'<a NOPRINT HREF="TOP.html" action="html:' , self name , ' ' , backRef , '"> <IMG SRC="../icons/DocsUpArrow.gif" ALT="[back]"></A>'.
]
] ifFalse:[
s nextPutAll:'<a NOPRINT HREF="TOP.html"> <IMG SRC="../icons/DocsUpArrow.gif" ALT="[back]"></A>'.
].
backRef ~~ #none ifTrue:[
s nextPutAll:'<hr>
'.
].
s nextPutAll:'
<h1>
'.
s nextPutLine:title.
s nextPutAll:'
</h1>
<ul>
'.
classNames do:[:nm |
s nextPutLine:'<li><a href="../misc/onlyInSTX2.html" action="html:' , self name ,' htmlDocOf:' , nm , '">' , nm , '</A>'
].
s nextPutAll:'
</ul>
</body>
</html>
'.
^ s contents
"Created: / 23.4.1996 / 15:31:55 / cg"
"Modified: / 30.10.1997 / 13:21:32 / cg"
!
htmlClassesListOfCategory:category
"generate an HTML document string which contains HREFS for a list
of classes which are contained in a particular category."
^ self
htmlClassesListOfCategory:category
backTo:nil
"Modified: / 30.10.1997 / 13:21:23 / cg"
!
htmlClassesListOfCategory:category backTo:backRef
"generate an HTML document string which contains HREFS for a list
of classes which are contained in a particular category."
|classes|
classes := Smalltalk allClasses
select:[:cls | cls isPrivate not
and:[(cls isNameSpace not or:[cls == Smalltalk])
and:[cls category = category]]
].
^ self
htmlClasses:classes
title:('Classes in: ' , category)
backTo:backRef
"Created: / 23.4.1996 / 15:39:39 / cg"
"Modified: / 30.10.1997 / 13:21:16 / cg"
!
htmlClassesMatching:aMatchPattern backTo:backRef
"generate an HTML document string which contains HREFS
for a list of classes whose name matches a given matchPattern."
|classes cls|
classes := Smalltalk allClasses
select:[:cls | cls isPrivate not
and:[(cls isNameSpace not or:[cls == Smalltalk])
and:[aMatchPattern match:cls name]]
].
^ self
htmlClasses:classes
title:('Classes matching: ' , aMatchPattern)
backTo:backRef
"
self htmlClassesMatching:'Tgen::*' backTo:nil
"
"Modified: / 30.10.1997 / 13:21:06 / cg"
!
htmlDocOf:aClass
"generate an HTML document string which contains a classes documentation"
^ self htmlDocOf:aClass back:nil backRef:nil
"
self htmlDocOf:PostscriptPrinterStream
"
"Modified: / 30.10.1997 / 13:22:19 / cg"
!
htmlDocOf:aClass back:backCmd
"generate an HTML document string which contains a classes documentation"
^ self htmlDocOf:aClass back:backCmd backRef:nil
"Modified: / 30.10.1997 / 13:22:27 / cg"
!
htmlDocOf:aClass back:backCmd backRef:backRef
"generate a nice HTML page from a class, with a back-reference
to a command or document.
Extract sections from the classes documentation method,
where the following lines start a special subsection:
[see also:] - references to other classes and/or documents
[start with:] - one-liners to start a demonstration
[author:] - author(s) of this class
[warning:] - usage warnings if any
[hints:] - usage hints if any
Each section ends with an empty line - however, for formatting,
a line consisting of a single backslash character will be converted
to an empty line.
Also extract examples from the classes example method,
where executable examples are made from sections enclosed in:
[exBegin]
...
[exEnd]
these parts are displayed in courier and will be made executable.
everything else is plain documentation text.
"
^ self
htmlDocOf:aClass
back:backCmd
backRef:backRef
imagePath:'../icons'
!
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.
Extract sections from the classes documentation method,
where the following lines start a special subsection:
[see also:] - references to other classes and/or documents
[start with:] - one-liners to start a demonstration
[author:] - author(s) of this class
[warning:] - usage warnings if any
[hints:] - usage hints if any
Each section ends with an empty line - however, for formatting,
a line consisting of a single backslash character will be converted
to an empty line.
Also extract examples from the classes example method,
where executable examples are made from sections enclosed in:
[exBegin]
...
[exEnd]
these parts are displayed in courier and will be made executable.
everything else is plain documentation text.
"
|supers s indent m docu examples firstIndent firstNonEmpty
collectionOfCategories collectionOfClassCategories
revInfo pckgInfo subs refLines demoLines warnLines hintLines
backHRef authorLines first wasLoaded didLoadBin
privateClasses owner className metaClass shortName shortMetaName
text path|
aClass isNil ifTrue:[
^ '' "/ just in case ...
].
(wasLoaded := aClass isLoaded) ifFalse:[
"/ load it - but not a binary
didLoadBin := Smalltalk loadBinaries.
Smalltalk loadBinaries:false.
[
aClass autoload.
] valueNowOrOnUnwindDo:[
didLoadBin ifTrue:[Smalltalk loadBinaries:true].
]
].
owner := aClass owningClass.
privateClasses := aClass privateClassesSorted.
className := aClass name.
shortName := aClass nameWithoutPrefix.
metaClass := aClass class.
shortMetaName := metaClass nameWithoutPrefix.
"/
"/ extract documentation or comment, if there is any
"/
m := metaClass compiledMethodAt:#documentation.
m notNil ifTrue:[
docu := m comment.
] ifFalse:[
"try comment"
docu := aClass comment.
].
(docu notNil and:[docu isEmpty]) ifTrue:[
docu := nil
].
docu notNil ifTrue:[
docu := (docu copy
replChar:$< withString:'<')
replChar:$> withString:'>'.
docu := docu asStringCollection.
"/
"/ search for a [see also:] section
"/
refLines := self extractSpecial:'[see also:]' from:docu.
"/
"/ search for a [start with:] section
"/
demoLines := self extractSpecial:'[start with:]' from:docu.
"/
"/ search for a [author:] section
"/
authorLines := self extractSpecial:'[author:]' from:docu.
authorLines isNil ifTrue:[
authorLines := self extractSpecial:'[authors:]' from:docu.
].
"/
"/ search for a [warning:] section
"/
warnLines := self extractSpecial:'[warning:]' from:docu.
"/
"/ search for a [hints:] section
"/
hintLines := self extractSpecial:'[hints:]' from:docu.
hintLines isNil ifTrue:[
hintLines := self extractSpecial:'[hint:]' from:docu.
].
docu notEmpty ifTrue:[
"/
"/ strip off empty lines
"/
[docu notEmpty and:[(docu at:1) size == 0]] whileTrue:[
docu removeIndex:1
].
[docu notEmpty and:[(docu at:docu size) size == 0]] whileTrue:[
docu removeIndex:(docu size)
].
].
docu notEmpty ifTrue:[
firstIndent := docu first leftIndent.
firstIndent > 0 ifTrue:[
docu := docu collect:[:line |
line leftIndent >= firstIndent ifTrue:[
line copyFrom:firstIndent + 1.
] ifFalse:[
line
]
].
].
firstNonEmpty := docu findFirst:[:line | line notEmpty].
firstNonEmpty > 1 ifTrue:[
docu := docu copyFrom:firstNonEmpty
]
].
docu := docu asString.
].
refLines notNil ifTrue:[
refLines := refLines collect:[:l |
|t|
((t := l withoutSeparators) startsWith:'(') ifTrue:[
t
] ifFalse:[
l asCollectionOfWords
]
].
].
"/
"/ extract examples if there are any
"/
m := metaClass compiledMethodAt:#examples.
m notNil ifTrue:[
examples := m comment.
examples notNil ifTrue:[
examples isEmpty ifTrue:[
examples := nil
].
].
examples notNil ifTrue:[
examples := (examples copy
replChar:$< withString:'<')
replChar:$> withString:'>'.
examples := examples asStringCollection.
"/
"/ strip off empty lines
"/
[examples first size == 0] whileTrue:[
examples removeIndex:1
].
[examples last size == 0] whileTrue:[
examples removeIndex:(examples size)
].
examples notEmpty ifTrue:[
firstIndent := examples first withTabsExpanded leftIndent.
firstIndent > 0 ifTrue:[
examples := examples collect:[:line |
|l|
l := line withTabsExpanded.
l leftIndent >= firstIndent ifTrue:[
l copyFrom:firstIndent.
] ifFalse:[
l
]
].
].
firstNonEmpty := examples findFirst:[:line | line notEmpty].
firstNonEmpty > 1 ifTrue:[
examples := examples copyFrom:firstNonEmpty
]
].
]
].
collectionOfClassCategories := metaClass categories asSortedCollection.
collectionOfClassCategories size > 0 ifTrue:[
collectionOfClassCategories := collectionOfClassCategories asOrderedCollection.
collectionOfClassCategories remove:'documentation' ifAbsent:nil.
].
collectionOfCategories := aClass categories asSortedCollection.
collectionOfCategories size > 0 ifTrue:[
collectionOfCategories := collectionOfCategories asOrderedCollection.
].
(aClass == Autoload or:[aClass == Object]) ifTrue:[
subs := #()
] ifFalse:[
subs := aClass subclasses
asOrderedCollection sort:[:a :b | a name < b name].
].
s := '' writeStream.
s nextPutLine:'<html><head><title>'.
s nextPutAll:'Class: '; nextPutLine:(className).
s nextPutLine:'</title></head><body>'.
backRef isNil ifTrue:[
backHRef := 'TOP.html'
] ifFalse:[
backHRef := backRef
].
backCmd notNil ifTrue:[
s nextPutAll:'<a NOPRINT HREF="' , backHRef , '" action="html:' , self name , ' ' , backCmd , '"> <IMG NOPRINT SRC="' , imagePath , '/DocsUpArrow.gif" ALT="[back]"></A>'.
s nextPutLine:'<hr>'.
] ifFalse:[
backHRef ~~ #none ifTrue:[
s nextPutAll:'<a NOPRINT HREF="' , backHRef , '"> <IMG NOPRINT SRC="' , imagePath , '/DocsUpArrow.gif" ALT="[back]"></A>';cr.
s nextPutLine:'<hr>'.
]
].
s nextPutLine:'<h1>'.
s nextPutAll:'Class: ';
nextPutAll:'<a INFO="open a browser on ' , shortName , '" type="example" action="SystemBrowser openInClass:' , className , '">';
nextPutAll:(shortName); nextPutLine:'</a>'.
owner notNil ifTrue:[
s nextPutAll:' (private in ';
nextPutAll:'<a INFO="open a browser on ' , owner nameWithoutPrefix , '" type="example" action="SystemBrowser openInClass:' , owner name , '">';
nextPutAll:(owner nameWithoutPrefix); nextPutLine:'</a>)'.
] ifFalse:[
aClass nameSpace ~~ Smalltalk ifTrue:[
s nextPutAll:' (in ' , aClass nameSpace name , ')'
]
].
s nextPutLine:'</h1>'.
owner notNil ifTrue:[
s nextPutLine:'This class is only visible from within'.
s nextPutLine:owner nameWithoutPrefix.
owner owningClass notNil ifTrue:[
s nextPutAll:'(which is itself a private class of '.
s nextPutAll:owner owningClass nameWithoutPrefix.
s nextPutLine:')'
].
s nextPutLine:'.'
].
"/
"/ index
"/
"/ s nextPutAll:'Index:'; cr.
s nextPutLine:'<ul>'.
s nextPutLine:'<li><a href="#INHERITANCE" name="I_INHERITANCE">Inheritance</a>'.
docu notNil ifTrue:[
s nextPutLine:'<li><a href="#DESCRIPTION" name="I_DESCRIPTION">Description</a>'.
].
warnLines notNil ifTrue:[
warnLines := warnLines asStringCollection.
s nextPutLine:'<li><a href="#WARNING" name="I_WARNING">Warning</a>'.
].
hintLines notNil ifTrue:[
hintLines := hintLines asStringCollection.
s nextPutLine:'<li><a href="#HINTS" name="I_HINTS">Hints</a>'.
].
refLines notNil ifTrue:[
s nextPutLine:'<li><a href="#SEEALSO" name="I_SEEALSO">Related information</a>'.
].
"/ s nextPutLine:'<li><a href="#INSTANCEVARIABLES" name="I_INSTANCEVARIABLES">Instance variables</a>'.
"/ s nextPutLine:'<li><a href="#CLASSVARIABLES" name="I_CLASSVARIABLES">Class variables</a>'.
collectionOfClassCategories size > 0 ifTrue:[
s nextPutLine:'<li><a href="#CLASSPROTOCOL" name="I_CLASSPROTOCOL">Class protocol</a>'.
s nextPutLine:'<ul>'.
collectionOfClassCategories sort do:[:cat |
s nextPutLine:'<li><a name="I_' , shortMetaName , '_category_' , cat , '"' ,
' href="#' , shortMetaName , '_category_' , cat ,
'">' , cat , '</a> '.
].
s nextPutLine:'</ul>'.
].
collectionOfCategories size > 0 ifTrue:[
s nextPutLine:'<li><a href="#INSTANCEPROTOCOL" name="I_INSTANCEPROTOCOL">Instance protocol</a>'.
s nextPutLine:'<ul>'.
collectionOfCategories sort do:[:cat |
s nextPutLine:'<li><a name="I_' , shortName , '_category_' , cat , '"' ,
' href="#' , shortName , '_category_' , cat ,
'">' , cat , '</a> '.
].
s nextPutLine:'</ul>'.
].
privateClasses size > 0 ifTrue:[
privateClasses := privateClasses asOrderedCollection sort:[:a :b | a nameWithoutPrefix < b nameWithoutPrefix].
s nextPutLine:'<li><a href="#PRIVATECLASSES" name="I_PRIVATECLASSES">Private classes</a>'.
].
(aClass == Object or:[aClass == Autoload]) ifTrue:[
s nextPutLine:'<li><a href="#SUBCLASSES" name="I_SUBCLASSES">Subclasses</a>'.
].
demoLines notNil ifTrue:[
s nextPutLine:'<li><a href="#DEMOSTARTUP" name="I_DEMOSTARTUP">Demonstration</a>'.
].
examples notNil ifTrue:[
s nextPutLine:'<li><a href="#EXAMPLES" name="I_EXAMPLES">Examples</a>'.
].
s nextPutLine:'</ul>'; nextPutLine:'<hr>'.
"/
"/ hierarchy
"/
s nextPutLine:'<h2><a name="INHERITANCE" href="#I_INHERITANCE">Inheritance:</A></h2>'.
s nextPutLine:'<pre>'.
indent := 3.
first := true.
supers := aClass allSuperclasses.
(supers size > 0) ifTrue:[
supers reverseDo:[:cls |
|nm|
nm := cls name.
first ifFalse:[
s spaces:indent; nextPutLine:'|'.
s spaces:indent; nextPutAll:'+--'.
indent := indent + 3.
] ifTrue:[
s spaces:indent
].
first := false.
s nextPutLine:'<a INFO="show documentation of ' , nm , '" href="../misc/onlyInSTX2.html" action="html:' , self name , ' htmlDocOf:' , nm , '">' , nm , '</A>'.
].
s spaces:indent; nextPutLine:'|'.
s spaces:indent.
s nextPutAll:'+--<B>'; nextPutAll:className; nextPutLine:'</B>'.
indent := indent + 3.
] ifFalse:[
s spaces:indent; nextPutLine:'nil'.
s spaces:indent; nextPutLine:'|'.
s spaces:indent; nextPutAll:'+--<B>'; nextPutAll:className; nextPutLine:'</B>'.
aClass ~~ Object ifTrue:[
s cr.
s nextPutLine:' <B>This class inherits NOTHING - most messages will lead into doesNotUnderstand:</B>'
].
indent := indent + 3.
].
subs notEmpty ifTrue:[
subs do:[:aSubclass |
|nm|
nm := aSubclass name.
s spaces:indent; nextPutLine:'|'.
s spaces:indent; nextPutAll:'+--'.
s nextPutLine:'<a INFO="show documentation of ' , nm , '" href="../misc/onlyInSTX2.html" action="html:' , self name , ' htmlDocOf:' , nm , '">' , nm , '</A>'.
]
] ifFalse:[
aClass == Object ifTrue:[
s spaces:indent; nextPutLine:'|'.
s spaces:indent; nextPutLine:'+-- ... almost every other class ...'
]
].
s nextPutLine:'</pre>'; nextPutLine:'<hr>'.
"/
"/ category, version & package
"/
s nextPutLine:'<dl>'.
s nextPutLine:'<dt><a name="CATEGORY"><b>Category:</b></A>'.
s nextPutLine:'<dd><b>', aClass category , '</b>'.
s nextPutLine:'</dl>'.
owner notNil ifTrue:[
s nextPutLine:'<dl>'.
s nextPutLine:'<dt><a name="OWNER"><b>Owner:</b></A>'.
s nextPutAll:'<dd><b>';
nextPutAll:'<a INFO="show documentation of ' , owner nameWithoutPrefix , '" href="../misc/onlyInSTX2.html" action="html:' , self name , ' htmlDocOf:' , owner name , '">' , owner nameWithoutPrefix , '</A>';
nextPutLine:'</b>'.
] ifFalse:[
self htmlRevisionDocOf:aClass to:s.
].
s nextPutLine:'</dl>'.
authorLines notNil ifTrue:[
s nextPutLine:'<dl><dt><a name="AUTHOR"><b>Author:</b></A>'.
authorLines do:[:l|
s nextPutLine:'<dd><b>', l , '</b>'.
].
s nextPutLine:'</dl>'.
].
s nextPutLine:'<hr>'.
docu notNil ifTrue:[
s nextPutLine:'<h2><a name="DESCRIPTION" href="#I_DESCRIPTION">Description:</A></h2>'.
s nextPutLine:'<BR>'.
s nextPutLine:'<pre>'.
s nextPutLine:docu.
s nextPutLine:'</pre>'.
s nextPutLine:'<hr>'.
].
warnLines notNil ifTrue:[
s nextPutLine:'<h2><a name="WARNING" href="#I_WARNING">Warning:</A></h2>'.
s nextPutLine:'<BR>'.
s nextPutLine:'<pre>'.
firstIndent := warnLines first leftIndent.
warnLines do:[:aLine |
aLine leftIndent >= firstIndent ifTrue:[
s nextPutLine:(aLine copyFrom:firstIndent+1)
] ifFalse:[
s nextPutLine:aLine
].
].
s nextPutLine:'</pre>'.
s nextPutLine:'<hr>'.
].
hintLines notNil ifTrue:[
s nextPutLine:'<h2><a name="HINTS" href="#I_HINTS">Hints:</A></h2>'.
s nextPutLine:'<BR>'.
s nextPutLine:'<pre>'.
firstIndent := hintLines first leftIndent.
hintLines do:[:aLine |
aLine leftIndent >= firstIndent ifTrue:[
s nextPutLine:(aLine copyFrom:firstIndent+1)
] ifFalse:[
s nextPutLine:aLine
].
].
s nextPutLine:'</pre>'.
s nextPutLine:'<hr>'.
].
"/
"/ see also
"/
refLines notNil ifTrue:[
s nextPutLine:'<h2><a name="SEEALSO" href="#I_SEEALSO">Related information:</A></h2>'.
s nextPutLine:'<pre>'.
refLines do:[:l |
|nm href|
s nextPutAll:' '.
l isString ifTrue:[
nm := (l copyFrom:2 to:(l indexOf:$:)-1) withoutSpaces.
href := (l copyFrom:(l indexOf:$:)+1 to:(l size - 1)) withoutSpaces.
(href startsWith:'man:') ifTrue:[
href := (href copyFrom:5) withoutSpaces.
s nextPutAll:'<a INFO="show man page" href="../misc/onlyInSTX2.html" action="html:' , self name , ' manPageFor:''' , href , '''">[<I>' , nm , '</I>]</A>'.
] ifFalse:[
(href startsWith:'html:') ifTrue:[
href := (href copyFrom:6) withoutSpaces.
].
s nextPutAll:'<a href="../' , href , '">[<I>' , nm , '</I>]</a>'.
]
] ifFalse:[
l do:[:ref |
|realRef ns|
(ref includesMatchCharacters) ifTrue:[
s nextPutAll:'<a INFO="show documentation of ' , ref , '" href="../misc/onlyInSTX2.html" action="html:' , self name , ' htmlClassesMatching:''' , ref , ''' backTo:nil">' , ref , '</A>'.
] ifFalse:[
realRef := ref.
(ns := aClass nameSpace) notNil ifTrue:[
ns isNameSpace ifTrue:[
(ns at:realRef asSymbol) notNil ifTrue:[
realRef := ns name , '::' , realRef
]
] ifFalse:[
]
].
s nextPutAll:'<a INFO="show documentation of ' , realRef , '" href="../misc/onlyInSTX2.html" action="html:' , self name , ' htmlDocOf:' , realRef , '">' , ref , '</A>'.
s nextPutAll:' '.
]
].
].
s cr.
].
s nextPutLine:'</pre>'.
s nextPutLine:'<hr>'.
].
"/
"/ inst & classVars
"/ to be added
"/
"/ protocol
"/
self printOutHTMLProtocolOf:aClass on:s.
"/
"/ subclasses (only for Object and Autoload)
"/
(aClass == Object or:[aClass == Autoload]) ifTrue:[
subs := aClass subclasses
asOrderedCollection sort:[:a :b | a name < b name].
s nextPutLine:'<h2><a name="SUBCLASSES" href="#I_SUBCLASSES">Subclasses (direct subclasses only):</A></h2>'.
s nextPutLine:'<pre>'.
subs do:[:cls |
|nm|
nm := cls name.
s nextPutAll:' '.
cls isLoaded ifFalse:[
s nextPutLine:'<a INFO="show documentation of ' , nm , '" href="../misc/onlyInSTX2.html" action="html:' , nm , ' autoload. ',self name,' htmlDocOf:' , nm, '">' , nm , '</A>'
] ifTrue:[
s nextPutLine:'<a INFO="show documentation of ' , nm , '" href="../misc/onlyInSTX2.html" action="html:',self name,' htmlDocOf:' , nm , '">' , nm , '</A>'
].
].
s nextPutLine:'</pre>'; nextPutLine:'<hr>'.
].
"/
"/ private classes
"/
privateClasses size > 0 ifTrue:[
s nextPutLine:'<h2><a name="PRIVATECLASSES" href="#I_PRIVATECLASSES">Private classes:</A></h2>'.
s nextPutLine:'<pre>'.
privateClasses do:[:cls |
|nm fullName|
nm := cls nameWithoutPrefix.
fullName := cls owningClass name , '::' , nm.
s nextPutAll:' '.
s nextPutLine:'<a INFO="show documentation of ' , fullName , '" href="../misc/onlyInSTX2.html" action="html:',self name,' htmlDocOf:' , fullName , '">' , nm , '</A>'
].
s nextPutLine:'</pre>'; nextPutLine:'<hr>'.
].
"/
"/ demonstration
"/
demoLines notNil ifTrue:[
s nextPutLine:'<h2><a name="DEMOSTARTUP" href="#I_DEMOSTARTUP">Demonstration:</A></h2>'.
demoLines do:[:l |
s nextPutLine:'<a INFO="demonstration" type="example">'.
s nextPutLine:'<code><pre>'.
s nextPutLine:' ' , l withoutSeparators.
s nextPutLine:'</pre></code>'.
s nextPutLine:'</a>'.
s nextPutLine:'<br>'.
].
s nextPutLine:'<hr>'.
].
"/
"/ add examples if there are any
"/
examples notNil ifTrue:[
s nextPutLine:'<h2><a name="EXAMPLES" href="#I_EXAMPLES">Examples:</A></h2>'.
s nextPutLine:'<BR>'.
s nextPutLine:'<code><pre>'.
examples do:[:line |
line withoutSeparators = '[exBegin]' ifTrue:[
s nextPutLine:'<a INFO="execute the example" type="example" showresult>'.
] ifFalse:[
line withoutSeparators = '[exEnd]' ifTrue:[
s nextPutLine:'</a>'.
] ifFalse:[
s nextPutLine:line
]
].
].
s nextPutLine:'</pre></code>'; nextPutLine:'<hr>'.
].
s nextPutLine:'</body>'; nextPutLine:'</html>'.
wasLoaded ifFalse:[
aClass unload
].
^ s contents
"
self htmlDocOf:Object
self htmlDocOf:Array
self htmlDocOf:Filename
self htmlDocOf:Block
"
"Created: / 24.4.1996 / 15:01:59 / cg"
"Modified: / 25.11.1998 / 12:40:51 / cg"
!
htmlDocOf:aClass backRef:backRef
"generate an HTML document string which contains a classes documentation"
^ self htmlDocOf:aClass back:nil backRef:backRef
"Created: / 24.4.1996 / 15:03:25 / cg"
"Modified: / 30.10.1997 / 13:23:12 / cg"
!
htmlDocOfImplementorsOf:selector
"generate an HTML document string which contains HREFS
to all implementors of a particular selector"
|sel s classes|
sel := (selector copy
replChar:$< withString:'<')
replChar:$> withString:'>'.
s := '' writeStream.
s nextPutLine:'<html><head><title>'.
s nextPutLine:sel.
s nextPutLine:'</title></head>'.
s nextPutLine:'<body>'.
s nextPutLine:'<a NOPRINT HREF="TOP.html"> <IMG SRC="../icons/DocsUpArrow.gif" ALT="[back]"></A>'.
s nextPutLine:'<hr>'.
s nextPutAll:'<h1>'; nextPutAll:sel; nextPutAll:'</h1>'.
s nextPutLine:'<dl>'.
classes := IdentitySet new.
sel := selector asSymbol.
Smalltalk allClassesDo:[: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>'.
s nextPutLine:'</body></html>'.
^ s contents
"Created: / 22.4.1996 / 20:03:31 / cg"
"Modified: / 30.10.1998 / 22:15:30 / 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.
].
text isNil ifTrue:[text := '?'].
] ifFalse:[
text := '?'
]
].
s nextPutLine:'</b> directory: <b>' , text , '</b>'.
text := revInfo at:#module ifAbsent:(pckgInfo at:#module ifAbsent:nil).
text isNil ifTrue:[
path := revInfo at:#repositoryPathName ifAbsent:(pckgInfo at:#repositoryPathName ifAbsent:nil).
path notNil ifTrue:[
SourceCodeManager notNil ifTrue:[
text := SourceCodeManager moduleFromContainerPath:path.
].
text isNil ifTrue:[text := '?'].
] ifFalse:[
text := '?'
]
].
s nextPutAll:'<dd>module: <b>' , text.
text := revInfo at:#library ifAbsent:(pckgInfo at:#library ifAbsent:'*none*').
s nextPutLine:'</b> stc-classLibrary: <b>' , text , '</b>'.
].
"Created: / 8.1.1997 / 13:43:28 / cg"
"Modified: / 30.10.1997 / 13:24:39 / cg"
!
htmlSelectorList
"generate an HTML string for all selectors (for which methods exist)
in the system"
|selectors|
selectors := IdentitySet new.
Smalltalk allClassesDo:[:cls |
selectors addAll:cls methodDictionary keys.
].
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 allClassesDo:[:cls |
cls methodDictionary keysDo:[:sel |
(pattern match:sel) ifTrue:[
selectors add:sel.
]
]
].
selectors := selectors asOrderedCollection sort.
^ self htmlSelectors:selectors title:('Selectors matching ''' , pattern , ''':').
"
self htmlSelectorListMatching:'*do*'
"
"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 allClassesDo:[:cls |
cls methodDictionary keysDo:[:sel |
(sel startsWith:prefix) ifTrue:[
selectors add:sel.
]
]
].
selectors := selectors asOrderedCollection sort.
^ self htmlSelectors:selectors title:('Selectors starting with ''' , prefix asString , ''':').
"
self htmlSelectorListPrefix:'a'
"
"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 := '' writeStream.
s nextPutLine:'<html><head><title>'.
s nextPutLine:title.
s nextPutLine:'</title></head>'.
s nextPutLine:'<body>'.
s nextPutLine:'<a NOPRINT HREF="TOP.html"> <IMG SRC="../icons/DocsUpArrow.gif" ALT="[back]"></A>'.
s nextPutLine:'<hr>'.
s nextPutAll:'<h1>'; nextPutAll:title; nextPutAll:'</h1>'.
s nextPutLine:'<ul>'.
selectors do:[:sel |
|nm|
nm := (sel copy replChar:$< withString:'<')
replChar:$> withString:'>'.
s nextPutLine:'<li><a href="../misc/onlyInSTX2.html" action="html:',self name,' htmlDocOfImplementorsOf:''' , nm , '''">' , nm , '</A>'
].
s nextPutLine:'</ul>'.
s nextPutLine:'</body></html>'.
^ s contents
"Created: / 22.4.1996 / 20:03:31 / cg"
"Modified: / 30.10.1997 / 13:26:34 / 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:[
ErrorSignal catch:[
self printOutHTMLMethodProtocol:aMethod on:aStream.
].
aStream nextPutLine:'<p>'.
]
].
aStream nextPutLine:'</dl>'.
]
]
"
self printOutHTMLProtocolOf:Float on:Stdout
"
"Created: / 22.4.1996 / 20:03:30 / cg"
"Modified: / 5.6.1996 / 13:41:27 / stefan"
"Modified: / 30.10.1997 / 13:27:58 / cg"
!
printOutHTMLMethodProtocol:aMethod on:aStream
"given the source in aString, print the methods message specification
and any method comments - without source; used to generate documentation
pages"
^ self
printOutHTMLMethodProtocol:aMethod
on:aStream
showClassName:false
classRef:false
"Modified: 22.4.1996 / 18:01:56 / cg"
"Created: 22.4.1996 / 20:03:30 / cg"
!
printOutHTMLMethodProtocol:aMethod on:aStream showClassName:showClassName classRef:withClassRef
"given the source in aString, print the methods message specification
and any method comments - without source; used to generate documentation
pages"
^ self
printOutHTMLMethodProtocol:aMethod
on:aStream
showClassName:showClassName
classRef:withClassRef
picturePath:'pictures'
!
printOutHTMLMethodProtocol:aMethod on:aStream showClassName:showClassName classRef:withClassRef picturePath:picturePath
"given the source in aString, print the methods message specification
and any method comments - without source; used to generate documentation
pages"
|comment cls sel partStream args argStream who methodSpecLine first
firstIndent firstNonEmpty isSubres isObsolete smallOrEmpty
ballColor|
who := aMethod who.
cls := who methodClass.
sel := who methodSelector.
partStream := sel keywords readStream.
(args := aMethod methodArgNames) notNil ifTrue:[
argStream := aMethod methodArgNames readStream.
methodSpecLine := ''. first := true.
1 to:sel numArgs do:[:index |
first ifTrue:[
first := false.
] ifFalse:[
methodSpecLine := methodSpecLine , ' '
].
methodSpecLine := methodSpecLine , '<B>' , partStream next , '</B>'.
methodSpecLine := methodSpecLine , ' <I>' , argStream next , '</I>'.
].
] ifFalse:[
methodSpecLine := '<B>' , partStream next , '</B>'
].
"/ use string-asSymbol (instead of the obvious symbol itself)
"/ in the checks below, to avoid tricking myself,
"/ when the documentation on this method is generated
"/ (otherwise, I'll say that this method is both
"/ a subres and and obsolete method ...)
isSubres := (aMethod sends:'subclassResponsibility' asSymbol).
isObsolete := false.
((aMethod sends:'obsoleteMethodWarning' asSymbol)
or:[(aMethod sends:'obsoleteMethodWarning:' asSymbol)
or:[(aMethod sends:'obsoleteMethodWarning:from:' asSymbol)]]) ifTrue:[
cls ~~ Object ifTrue:[
isObsolete := true
]
].
smallOrEmpty := ''.
aMethod isPrivate ifTrue:[
methodSpecLine := '<i>private</i> ' , methodSpecLine.
"/ smallOrEmpty := '-small'.
] ifFalse:[
aMethod isProtected ifTrue:[
methodSpecLine := '<i>protected</i> ' , methodSpecLine.
"/ smallOrEmpty := '-small'.
] ifFalse:[
aMethod isIgnored ifTrue:[
methodSpecLine := '[ ' , methodSpecLine , ' ] (<i>invisible</i>)'.
"/ smallOrEmpty := '-small'.
]
]
].
aStream nextPutLine:'<DT>'.
cls isMeta ifTrue:[
ballColor := 'yellow'
] ifFalse:[
ballColor := 'red'
].
aStream nextPutLine:'<IMG src="' , picturePath , '/' , ballColor , '-ball' , smallOrEmpty , '.gif" alt="o " width=6 height=6>'.
sel := (sel copy
replChar:$< withString:'<')
replChar:$> withString:'>'.
withClassRef ifTrue:[
aStream nextPutLine:'<a name="' , cls name , '_' , sel ,
'" href="../misc/onlyInSTX2.html" action="html:',self name,' htmlDocOf:' , cls name ,
'">' , cls name , '</a> ' , methodSpecLine.
] ifFalse:[
showClassName ifTrue:[
methodSpecLine := cls name , ' ' , methodSpecLine
].
aStream nextPutLine:'<a name="' , cls name , '_' , sel , '" ' ,
"/ 'href="' , cls name , '_' , sel , '"' ,
'>' , methodSpecLine , '</a>'.
].
aStream nextPutLine:'<DD>'.
(comment := aMethod comment) notNil ifTrue:[
comment := (comment copy
replChar:$< withString:'<')
replChar:$> withString:'>'.
comment notEmpty ifTrue:[
comment := comment asStringCollection.
firstIndent := comment first leftIndent.
firstIndent > 0 ifTrue:[
comment := comment collect:[:line |
line leftIndent >= firstIndent ifTrue:[
line copyFrom:firstIndent.
] ifFalse:[
line
]
].
].
firstNonEmpty := comment findFirst:[:line | line notEmpty].
firstNonEmpty > 1 ifTrue:[
comment := comment copyFrom:firstNonEmpty
].
comment := comment asString.
].
comment asStringCollection do:[:line |
aStream nextPutAll:line; nextPutLine:'<BR>'.
].
].
isSubres ifTrue:[
aStream nextPutLine:'<BR>'.
aStream nextPutLine:'<I>** This method raises an error - it must be redefined in concrete classes **</I>'.
].
isObsolete ifTrue:[
aStream nextPutLine:'<BR>'.
aStream nextPutLine:'<I>** This is an obsolete interface - do not use it (it may vanish in future versions) **</I>'.
].
"Created: / 22.4.1996 / 20:03:30 / cg"
"Modified: / 30.10.1997 / 13:09:45 / cg"
!
printOutHTMLProtocolOf:aClass on:aStream
"append documentation of the given class in HTML onto aStream."
|collectionOfCategories any|
"/ self printOutDefinitionOn:aPrintStream.
collectionOfCategories := aClass class categories asSortedCollection.
any := false.
collectionOfCategories size > 0 ifTrue:[
collectionOfCategories := collectionOfCategories asOrderedCollection.
collectionOfCategories remove:'documentation' ifAbsent:[].
collectionOfCategories size > 0 ifTrue:[
collectionOfCategories sort.
aStream nextPutLine:'<h2><a name="CLASSPROTOCOL" href="#I_CLASSPROTOCOL">Class protocol:</a></h2>'.
collectionOfCategories do:[:aCategory |
self printOutHTMLCategoryProtocol:aCategory of:aClass class on:aStream.
any := true.
].
"/ any ifFalse:[
"/ aStream nextPutAll:'no new protocol'
"/ ].
aStream nextPutLine:'<hr>'.
]
].
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'
"/ ].
aStream nextPutLine:'<hr>'.
]
"
self printOutHTMLProtocolOf:Float on:Stdout
"
"Created: / 22.4.1996 / 20:03:30 / cg"
"Modified: / 25.11.1998 / 12:40:59 / cg"
! !
!HTMLDocGenerator class 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"
|s t outStream state ch keep|
s := PipeStream readingFrom:manCommand.
s notNil ifTrue:[
outStream := '' writeStream.
state := nil.
keep := nil.
[s atEnd] whileFalse:[
ch := s next.
ch notNil ifTrue:[
state == nil ifTrue:[
ch == Character backspace ifTrue:[
state := #back
] ifFalse:[
keep notNil ifTrue:[
keep == $< ifTrue:[
outStream nextPutAll:'<'.
] ifFalse:[
outStream nextPut:keep.
].
].
keep := ch
]
] ifFalse:[
state == #back ifTrue:[
ch == keep ifTrue:[
outStream nextPutAll:'<b>'.
ch == $< ifTrue:[
outStream nextPutAll:'<'.
] ifFalse:[
outStream nextPut:ch.
].
outStream nextPutAll:'</b>'.
state := nil.
keep := nil.
] ifFalse:[
ch == $_ ifTrue:[
keep notNil ifTrue:[
outStream nextPutAll:'<i>'.
keep == $< ifTrue:[
outStream nextPutAll:'<'.
] ifFalse:[
outStream nextPut:keep.
].
outStream nextPutAll:'</i>'.
].
state := nil.
keep := nil.
] ifFalse:[
keep == $_ ifTrue:[
outStream nextPutAll:'<i>'.
ch == $< ifTrue:[
outStream nextPutAll:'<'.
] ifFalse:[
outStream nextPut:ch.
].
outStream nextPutAll:'</i>'.
state := nil.
keep := nil.
] ifFalse:[
keep notNil ifTrue:[
keep == $< ifTrue:[
outStream nextPutAll:'<'.
] ifFalse:[
outStream nextPut:keep.
].
ch == $< ifTrue:[
outStream nextPutAll:'<'.
] ifFalse:[
outStream nextPut:ch.
]
].
state := nil.
keep := nil.
]
]
]
]
]
]
].
keep notNil ifTrue:[
keep == $< ifTrue:[
outStream nextPutAll:'<'.
] ifFalse:[
outStream nextPut:keep
]
].
t := outStream contents.
s shutDown.
].
(t isNil or:[t isEmpty]) ifTrue:[
^ '
No manual page for "<CODE><B>' , aCommand , '</B></CODE>" available.
<BR>
(the failed command was: "<CODE>' , manCommand , '"</CODE>.)
'.
].
^ '
<pre>
' , t , '
</pre>
'
"
self manPageFor:'cvs'
"
"Modified: / 28.6.1996 / 21:28:47 / stefan"
"Created: / 9.9.1996 / 17:43:16 / cg"
"Modified: / 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"
! !
!HTMLDocGenerator class methodsFor:'helpers'!
extractSpecial:pattern from:docu
"given a collection of docu lines (from documentation methods comment),
extract things like [see also:], [author:] etc.
If found, remove the lines from the string collection,
and return the extracted ones. Otherwise return nil."
|srchIdx idx lines l|
srchIdx := docu findFirst:[:l | l asLowercase withoutSeparators = pattern].
srchIdx ~~ 0 ifTrue:[
lines := OrderedCollection new.
idx := srchIdx+1.
[idx <= docu size] whileTrue:[
l := docu at:idx.
(l isNil or:[l withoutSeparators size == 0]) ifTrue:[
idx := docu size + 1.
] ifFalse:[
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"
! !
!HTMLDocGenerator class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic3/HTMLDocGenerator.st,v 1.34 2002-02-25 19:57:49 cg Exp $'
! !