reports/Builder__ReportExtensionsSourceInfo.st
author Claus Gittinger <cg@exept.de>
Thu, 28 Mar 2019 13:54:38 +0100
changeset 542 aa25a71be62a
parent 274 b13db8438e4a
child 534 1bed627ec135
permissions -rw-r--r--
#DOCUMENTATION by cg
class: stx_goodies_builder_quickSelfTest
class definition

class: stx_goodies_builder_quickSelfTest class
added:18 methods
     1 "{ Encoding: utf8 }"
     2 
     3 "{ Package: 'stx:goodies/builder/reports' }"
     4 
     5 "{ NameSpace: Builder }"
     6 
     7 ReportSourceInfo subclass:#ReportExtensionsSourceInfo
     8 	instanceVariableNames:''
     9 	classVariableNames:''
    10 	poolDictionaries:''
    11 	category:'Builder-Reports-Utils'
    12 !
    13 
    14 
    15 !ReportExtensionsSourceInfo methodsFor:'accessing'!
    16 
    17 pathNameAbsolute: aBoolean
    18     "Return a path (as String) to file containing the source code. The file points to the
    19      real source file. If `aBoolean` is true, then absolute path is returned, otherwise
    20      realtive path to package root is returned."
    21 
    22     | packageDir |
    23 
    24     packageDir := aBoolean 
    25                     ifTrue:[ (Smalltalk getPackageDirectoryForPackage: package) pathName ]
    26                     ifFalse: [ package asString replaceAll: $: with: Filename separator; replaceAll: $/ with: Filename separator ].
    27 
    28     ^ packageDir , Filename separator , 'extensions.st'.
    29 
    30     "
    31     (Builder::ReportSourceInfo forExtensionsInPackage: 'stx:libtool') pathNameAbsolute: true
    32     (Builder::ReportSourceInfo forExtensionsInPackage: 'stx:libtool') pathNameAbsolute: false
    33     "
    34 
    35     "Created: / 16-12-2014 / 10:27:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    36 ! !
    37 
    38 !ReportExtensionsSourceInfo methodsFor:'initialization'!
    39 
    40 initializeWithPackage: pkg
    41     package := pkg.
    42     self setup.
    43 
    44     "Created: / 29-07-2013 / 18:38:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    45 ! !
    46 
    47 !ReportExtensionsSourceInfo methodsFor:'utilities'!
    48 
    49 fileOutOn: streamArg
    50     "This code is stupid as it is a copy-paste of several methods here and there that
    51      files out an extension.st. But the the original code is so rubbish so I had
    52      to do it this way. Sorry."
    53 
    54     | extensions wide stream s methodsSortedByName defClass scmManagerOrNil |
    55 
    56     extensions := ProjectDefinition searchForExtensionsWithProject: package.     
    57     extensions isEmptyOrNil ifTrue:[ ^ self ].
    58     wide := false.
    59     stream := streamArg.
    60     extensions do:[:method|
    61         wide := wide or:[method source isWideString].
    62     ].
    63     wide ifTrue:[
    64         stream := EncodedStream stream: stream encoder: (CharacterEncoder encoderForUTF8).      
    65         stream nextPutAll: '"{ Encoding: utf8 }"'; cr;cr.
    66     ].
    67 
    68     s := stream.
    69 
    70     s nextPutAll:'"{ Package: '''.
    71     s nextPutAll:package asString.
    72     s nextPutAll:''' }"'; nextPutChunkSeparator; cr; cr.
    73 
    74     "/ don't write a timestamp. Otherwise we would always generate a new version, even if nothing changed
    75     "/ s nextPutAll:(Smalltalk timeStamp).
    76     "/ s nextPutChunkSeparator. 
    77     "/ s cr; cr.
    78 
    79     "/ sort them by name (to avoid conflicts due to SCM merge)
    80     methodsSortedByName := extensions asOrderedCollection.
    81     methodsSortedByName sort:[:a :b |
    82                                 |clsA clsB|
    83 
    84                                 clsA := a mclass name.
    85                                 clsB := b mclass name.
    86                                 clsA < clsB ifTrue:[
    87                                     true
    88                                 ] ifFalse:[
    89                                     clsA > clsB ifTrue:[
    90                                         false
    91                                     ] ifFalse:[
    92                                         a selector < b selector
    93                                     ]
    94                                 ]
    95                               ].
    96     methodsSortedByName do:[:aMethod |
    97         |cat privacy aStream|
    98 
    99         aStream := s.
   100 
   101     aStream nextPutChunkSeparator.
   102     aMethod mclass name printOn:aStream.
   103 "/        self printClassNameOn:aStream.
   104 
   105     (privacy := aMethod privacy) ~~ #public ifTrue:[
   106         aStream space; nextPutAll:privacy; nextPutAll:'MethodsFor:'.
   107     ] ifFalse:[
   108         aStream nextPutAll:' methodsFor:'.
   109     ].
   110 
   111     cat := aMethod category ? ''.
   112     aStream nextPutAll:cat asString storeString.
   113     aStream nextPutChunkSeparator; cr; cr.
   114 
   115     SmalltalkChunkFileSourceWriter new fileOutMethod:aMethod on:aStream.
   116 
   117     aStream space.
   118     aStream nextPutChunkSeparator.
   119             aStream cr.    
   120         s cr.
   121     ].
   122 
   123     scmManagerOrNil := AbstractSourceCodeManager managerForPackage: package.
   124     scmManagerOrNil notNil ifTrue:[
   125         defClass := ProjectDefinition definitionClassForPackage:package.
   126         defClass notNil ifTrue:[
   127             "/ make sure, an extensionVersion_XXX method is included...
   128             "/ (notice: no need to support a secondary backward compatible non-manager related version method here)
   129             (methodsSortedByName contains:[:aMethod | aMethod selector == scmManagerOrNil nameOfVersionMethodForExtensions]) ifFalse:[
   130                 s nextPutLine:('!!%1 class methodsFor:''documentation''!!' bindWith:defClass name).
   131                 s cr.
   132                 s nextChunkPut:
   133                     (scmManagerOrNil versionMethodTemplateForSmalltalkFor:(scmManagerOrNil nameOfVersionMethodForExtensions)).
   134                 s space; nextPutChunkSeparator; cr.
   135             ].
   136         ].
   137     ].
   138 
   139     "Modified: / 09-03-2015 / 15:55:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   140 !
   141 
   142 validate
   143     | extensions file |
   144 
   145     extensions := ProjectDefinition searchForExtensionsWithProject: package.     
   146     file := (Smalltalk getPackageDirectoryForPackage: package) / 'extensions.st'.                       
   147 
   148     extensions isEmptyOrNil ifTrue:[
   149         self assert: file exists not.
   150     ] ifFalse:[
   151         self validateAgainstReference: file.
   152     ]
   153 
   154     "Modified: / 09-03-2015 / 15:58:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   155 ! !
   156 
   157 !ReportExtensionsSourceInfo class methodsFor:'documentation'!
   158 
   159 version
   160     ^ '$Header$'
   161 !
   162 
   163 version_CVS
   164     ^ '$Header$'
   165 ! !
   166