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