HTMLDocGenerator.st
branchjv
changeset 4166 66a7a47f9253
parent 4118 d6872904c8cf
parent 4127 1a5ac450b16c
child 4207 9eccfc1cbc8d
--- a/HTMLDocGenerator.st	Wed Sep 07 16:04:00 2016 +0100
+++ b/HTMLDocGenerator.st	Mon Nov 28 17:11:46 2016 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
 "
  COPYRIGHT (c) 1996 by Claus Gittinger
               All Rights Reserved
@@ -48,10 +46,13 @@
 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 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
@@ -211,7 +212,8 @@
     CachedKWIC := nil
     "
     CachedKWIC isNil ifTrue:[
-        CachedKWIC := self generateKWIC.
+        "/ CachedKWIC := self generateKWIC.
+        CachedKWIC := self generateKWICForClassAndMethodNames.
         "/ to flush the cached kwic, whenever a class-documentation method is changed
         Smalltalk addDependent:self class. 
     ].
@@ -368,6 +370,54 @@
 
 !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|
 
@@ -375,37 +425,117 @@
         #(
             'the' 'a'
             'can' 'you' 
-            'to' 'in' 'at' 'of' 
+            'to' 'in' 'out' 'at' 'of' 
             'also' 'with' 'without' 'all' 'any' 'how' 
-            'however' 'although' 'always' 
+            'however' 'although' 'always' 'either' 'neither'
             'anywhere' 'anyway' 'anything' 'anyone'
-            'not' 'but'
+            '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'
+            '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 separatorAlgorithm:[:line | 
+            line asCollectionOfSubstringsSeparatedByAny:' ^~=@.:,;-+*/()[]|{}#"''<>',Character cr
+        ].
     kwic exclusionFilter:[:word | 
                 word size == 1
                 or:[ word conform:#isDigit ]].
-    
+
     Smalltalk allClassesDo:[:eachClass |
-        |doc|
+        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'
+        ).
         
-        doc := eachClass commentOrDocumentationString.
-        doc notEmptyOrNil ifTrue:[
-            kwic addLine:doc reference:eachClass ignoreCase:true.
-        ].    
+    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
 
     "
-     self generateKWIC
+     CachedKWIC := nil.
+     self generateKWICForClassAndMethodNames
     "
 !
 
@@ -2317,13 +2447,13 @@
         ].
     ].
 
-    aKWIC matchSorter:[:a :b | a value name < b value name].
+    aKWIC matchSorter:[:a :b | a key < b key].
     
-    aKWIC entriesDo:[:word :left :right :class|
+    aKWIC entriesDo:[:word :left :right :classOrMethod|
         |ref lcWord ctx|
 
         ctx := (HTMLUtilities escapeCharacterEntities:(left contractAtBeginningTo:25))
-               ,' <b>',(HTMLUtilities escapeCharacterEntities:word),'</b> '
+               , ' <b>',(HTMLUtilities escapeCharacterEntities:word),'</b> '
                ,(HTMLUtilities escapeCharacterEntities:(right contractAtEndTo:25)).
         
         lcWord := word asLowercase.
@@ -2334,14 +2464,22 @@
             "/ outStream nextPutLine:'<dt>',(HTMLUtilities escapeCharacterEntities:(caseMapping at:lcWord ifAbsent:[word])),'</dt>'.
             outStream nextPutLine:'<dt>',(HTMLUtilities escapeCharacterEntities:word),'</dt>'.
             outStream nextPutLine:'<dd><ul><li>'.
-            self generateClassDocReferenceFor:class name.
+            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>'.
-            self generateClassDocReferenceFor:class name.
+            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>'.
@@ -2363,7 +2501,21 @@
 !
 
 htmlPackageList
-    "generate an HTML string for a given list of selectors"
+    "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|
 
@@ -2377,7 +2529,7 @@
     self generateH1:'Package Index'.
     s nextPutLine:'<ul>'.
 
-    Smalltalk allPackageIDs
+    packageNames
         do:[:p |
             |pckgString|
 
@@ -2910,6 +3062,38 @@
     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"