"

 COPYRIGHT (c) 1996 by Claus Gittinger

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libhtml' }"

Object subclass:#HTMLDocGenerator

	instanceVariableNames:'outStream pathToTopOfDocumentation

		pathToLanguageTopOfDocumentation httpRequestOrNil

		generateBodyOnly backRef backCmd imagePath'

	classVariableNames:''

	poolDictionaries:''

	category:'System-Documentation'

!

!HTMLDocGenerator class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1996 by Claus Gittinger

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    Generates HTML documentation for a class.

    Although this is normally used with the SystemBrowser

    (classes-generate documentation menu),

    it may be useful on its own, to programatically generate

    up-to-date documents from a classes source.

    This generator extracts the documentation methods source

    (or comment), individual method comments (the first comment in

    a method) and version information to generate a neatly formatted

    HTML page.

    If executable examples (EXBEGIN .. EXEND) are present in the classes 

    documentation category these are also added as executable code

    to the document.

    [author:]

        Claus Gittinger

    [see also:]

        BrowserView

        HTMLDocumentView

"

! !

!HTMLDocGenerator class methodsFor:'document generation'!

htmlClassCategoryList

    "generate a formatted list of all available class categories as

     an HTML string. Each category will be a hyperlink to another

     autogenerated page, containing the classes per category.

     The generated page is supposed to be given to an HTML reader

     with home being set to ../doc/online/xxx/classDoc 

     (i.e. the images are to be found one-up in the doc hierarchy)"

    ^ self new htmlClassCategoryList

    "

     HTMLDocGenerator htmlClassCategoryList

    "

!

htmlClassListPrefix:prefix

    "generate an HTML document string which contains HREFS for a list

     of classes which start with some prefix (typically, the first

     character is given)"

    ^ self new htmlClassListPrefix:prefix

    "

     HTMLDocGenerator htmlClassListPrefix:'A'

    "

!

htmlClassesListOfCategory:aCategory backTo:backMessage

    "generate an HTML document string which contains HREFS for a list

     of classes which are contained in a particular category."

    ^ self new htmlClassesListOfCategory:aCategory backTo:backMessage

!

htmlDocOf:aClass

    "generate an HTML document string which contains a classes documentation"

    ^ self new htmlDocOf:aClass

    "

     HTMLDocGenerator htmlDocOf:Array

    "

!

htmlDocOf:aClass back:backCmd backRef:backRef imagePath:imagePath

    "generate a nice HTML page from a class, with a back-reference

     to a command or document."

    ^ self new htmlDocOf:aClass back:backCmd backRef:backRef imagePath:imagePath

!

htmlDocOf:aClass backRef:backRef

    "generate an HTML document string which contains a classes documentation"

    ^ self new htmlDocOf:aClass backRef:backRef

!

htmlDocOfImplementorsOf:selector

    "generate an HTML document string which contains HREFS

     to all implementors of a particular selector"

    ^ self new htmlDocOfImplementorsOf:selector

    "

     HTMLDocGenerator htmlDocOfImplementorsOf:#at:

    "

!

htmlSelectorList

    "generate an HTML string for all selectors (for which methods exist)

     in the system"

    ^ self new htmlSelectorList

    "

     HTMLDocGenerator htmlSelectorList

    "

!

htmlSelectorListMatching:prefix

    "generate an HTML string for all selectors which match a pattern

     (and for which methods exist) in the system"

    ^ self new htmlSelectorListMatching:prefix

!

htmlSelectorListPrefix:prefix

    "generate an HTML string for all selectors whose names starts with

     a prefix (and for which methods exist) in the system"

    ^ self new htmlSelectorListPrefix:prefix

    "

     HTMLDocGenerator htmlSelectorListPrefix:'a'

    "

!

manPageFor:aCommandName

    "generate a (unix-) man page for a given command & convert the output to html"

    ^ self new manPageFor:aCommandName

    "

     HTMLDocGenerator manPageFor:'ls'

     HTMLDocumentView openFullOnText:(HTMLDocGenerator manPageFor:'ls')

    "

!

manPageFor:aManPageTemplateFile manCommand:nroffCommand

    "convert man-command output to html.

     Only the body of the text (without head../head and body../body) is generated"

    ^ self new manPageFor:aManPageTemplateFile manCommand:nroffCommand

    "

     HTMLDocGenerator 

        manPageForFile:'/usr/man/man2/open.2'

        manCommand:'nroff -man /usr/man/man2/open.2'

    "

!

manPageForFile:aManPageTemplateFile

    "convert a .man file to html"

    ^ self new manPageForFile:aManPageTemplateFile

    "

     HTMLDocGenerator manPageForFile:'/usr/man/man2/open.2'

     HTMLDocumentView openFullOnText:(HTMLDocGenerator manPageForFile:'../../stc/stc.1')

    "

! !

!HTMLDocGenerator class methodsFor:'pathnames'!

languageSpecificDocDirectory

    |lang|

    lang := Smalltalk language.

    "XXX Kludge for now, map ISO-639 abbreviations to dir names.

     Should rename the directories"

    lang == #en ifTrue:[

        ^ 'english'.

    ].

    lang == #de ifTrue:[

        ^ 'german'.

    ].

    lang == #fr ifTrue:[

        ^ 'french'.

    ].

    lang == #it ifTrue:[

        ^ 'italian'.

    ].

    lang == #jp ifTrue:[

        ^ 'japanese'.

    ].

    ^ 'english'.

    "

     self languageSpecificDocDirectory

    "

! !

!HTMLDocGenerator methodsFor:'accessing'!

generateBodyOnly:something

    "set the value of the instance variable 'generateBodyOnly' (automatically generated)"

    generateBodyOnly := something.

!

httpRequest:aRequest

    httpRequestOrNil := aRequest.

!

pathToLanguageTopOfDocumentation:something

    "set the value of the instance variable 'pathToLanguageTopOfDocumentation' (automatically generated)"

    pathToLanguageTopOfDocumentation := something.

!

pathToTopOfDocumentation:something

    "set the value of the instance variable 'pathToTopOfDocumentation' (automatically generated)"

    pathToTopOfDocumentation := something.

! !

!HTMLDocGenerator methodsFor:'document generation'!

generateExampleEnd

    self generatingForSTXBrowser ifFalse:[

        outStream nextPutLine:'</font>'.

        ^ self

    ].

    outStream nextPutLine:'</a>'.

!

generateExampleStart

    self generatingForSTXBrowser ifFalse:[

        outStream nextPutLine:'<font color=#7F0000>'.

        ^ self

    ].

    outStream nextPutLine:'<a INFO="execute the example" type="example" showresult>'.

!

generateExamples:examples

    |inExample|

    inExample := false.

    outStream nextPutLine:'<h2><a name="EXAMPLES" href="#I_EXAMPLES">Examples:</A></h2>'.

    outStream nextPutLine:'<BR>'.

    outStream nextPutLine:'<code><pre>'.

    examples do:[:line |

        line withoutSeparators = '[exBegin]' ifTrue:[

            inExample ifTrue:[

                self generateExampleEnd.

            ].

            self generateExampleStart.

            inExample := true.

        ] ifFalse:[

            line withoutSeparators = '[exEnd]' ifTrue:[

                inExample ifTrue:[

                    self generateExampleEnd.

                ].

                inExample := false.

            ] ifFalse:[

                outStream nextPutLine:line

            ]

        ].

    ].

    inExample ifTrue:[

        self generateExampleEnd.

    ].

    outStream nextPutLine:'</pre></code>'.

    self generateHorizontalLine.

!

generatePrivateClassInfoFor:aClass with:privateClasses on:aStream

    |s|

    s := aStream.

        s nextPutLine:'<pre>'.

        privateClasses do:[:cls |

            |nm fullName|

            nm := cls nameWithoutPrefix.

            fullName := cls name.

            s nextPutAll:'    '.

            (cls owningClass isLoaded not

            or:[cls owningClass wasAutoloaded]) ifTrue:[

                self

                    generateClassDocReferenceFor:fullName 

                    text:nm 

                    autoloading:cls owningClass name

            ] ifFalse:[

                self generateClassDocReferenceFor:fullName text:nm.

            ].

        ].

        s nextPutLine:'</pre>'.

!

generateRefLines:refLines forClass:aClass on:aStream

    |s|

    s := aStream.

    s nextPutLine:'<pre>'.

    refLines do:[:l |

        |nm href|

        l isString ifTrue:[

            s nextPutAll:'    '.

            nm := (l copyFrom:2 to:(l indexOf:$:)-1) withoutSpaces.

            href := (l copyFrom:(l indexOf:$:)+1 to:(l size - 1)) withoutSpaces.

            (href startsWith:'man:') ifTrue:[

                href := (href copyFrom:5) withoutSpaces.

                s nextPutAll:'<a INFO="Show manual page" href="' , self pathToTopOfDocumentation , '/misc/onlyInSTX2.html" action="html:' , self class name , ' manPageFor:''' , href , '''">[<I>' , nm , '</I>]</A>'.

            ] ifFalse:[

                (href startsWith:'html:') ifTrue:[

                    href := (href copyFrom:6) withoutSpaces.

                ].                                             

                s nextPutAll:'<a href="' , (self pathToDocumentationFile:href) , '">[<I>' , nm , '</I>]</a>'.

            ].

            s cr.

        ] ifFalse:[

            l do:[:ref |

                |realRef ns|

                s nextPutAll:'    '.

                (ref includesMatchCharacters) ifTrue:[

                    s nextPutAll:(self 

                                anchorForHTMLDocAction:

                                    ('htmlClassesMatching:''' , ref , ''' backTo:nil')

                                info:

                                    ( 'Show documentation of ' , ref )

                                text:

                                    ref).

                ] ifFalse:[

                    realRef := ref.

                    ((ns := aClass nameSpace) notNil and:[ns ~~ Smalltalk]) ifTrue:[

                        ns isNameSpace ifTrue:[

                            (ns at:realRef asSymbol) notNil ifTrue:[

                                realRef := ns name , '::' , realRef

                            ]

                        ] ifFalse:[

                        ]

                    ].

                    self generateClassDocReferenceFor:realRef text:ref.

                ].

                s cr.

            ].

        ].

    ].

    s nextPutLine:'</pre>'.

!

generateSubclassInfoFor:aClass on:aStream

    |s subs|

    s := aStream.

    subs := aClass subclasses 

                asOrderedCollection sort:[:a :b | a name < b name].

    s nextPutLine:'<pre>'.

    subs do:[:cls |

        |nm|

        nm := cls name.

        s nextPutAll:'    '.

        cls isLoaded ifFalse:[

            self 

                generateClassDocReferenceFor:nm

                text:nm

                autoloading:nm

        ] ifTrue:[

            self generateClassDocReferenceFor:nm.

        ].

    ].

    s nextPutLine:'</pre>'.

!

htmlClassCategoryList

    "generate a formatted list of all available class categories as

     an HTML string. Each category will be a hyperlink to another

     autogenerated page, containing the classes per category.

     The generated page is supposed to be given to an HTML reader

     with home being set to ../doc/online/xxx/classDoc 

     (i.e. the images are to be found one-up in the doc hierarchy)"

    |categories s prefixList prefix prefixStack prev|

    categories := Smalltalk allClassCategories asOrderedCollection sort.

    outStream := s := '' writeStream.

    self generateHTMLHeadWithTitle:'Class Categories:'.

    self generateBODYStart.

    self generateUpArrowButtonForTop.

    self generateHorizontalLine.

    self generateH1:'Class Categories:'.

    s nextPutLine:'<ul>'.

    prefixList := Set new.

    categories keysAndValuesDo:[:index :element |

        |prev common|

        index ~~ 1 ifTrue:[

            prev := categories at:(index - 1).

            common := (Array with:prev with:element) longestCommonPrefix.

            (common endsWith:'-') ifTrue:[

                prefixList add:(common copyWithoutLast:1)

            ] ifFalse:[

                (common includes:$-) ifTrue:[

                    prefixList add:(common copyTo:(common lastIndexOf:$-)-1).

                ] ifFalse:[

"/                    common = prev ifTrue:[

"/                        prefixList add:common

"/                    ]

                ]

            ]

        ]

    ].

    prefix := ''. prefixStack := OrderedCollection new. 

    prev := ''.

    categories := categories select:[:nm | nm ~= 'obsolete'].

    categories do:[:nm |

        |longest|

        "/ longest prefix ....

        longest := prefixList inject:'' into:[:maxPrefix :prefix |

                        |prefixWithDash|

                        prefixWithDash := prefix , '-'.

                        nm = prefix ifTrue:[

                            maxPrefix

                        ] ifFalse:[

                            (nm startsWith:prefixWithDash)

                            ifTrue:[

                                prefixWithDash size > maxPrefix size

                                ifTrue:[

                                    prefixWithDash

                                ] ifFalse:[

                                    maxPrefix

                                ]

                            ] ifFalse:[

                                maxPrefix

                            ]

                        ]

                   ].

        longest size > 0 ifTrue:[

            longest = prefix ifTrue:[

                "/ no change

            ] ifFalse:[

                (longest startsWith:prefix) ifTrue:[