ProjectBuilder.st
author Claus Gittinger <cg@exept.de>
Sat, 10 Oct 2009 15:10:56 +0200
changeset 2598 2bb47a698d59
parent 2596 876679f78999
child 2599 e8624fcf3c1b
permissions -rw-r--r--
*** empty log message ***
cg@2596
     1
"{ Package: 'stx:libtool2' }"
cg@2596
     2
cg@2596
     3
Object subclass:#ProjectBuilder
cg@2596
     4
	instanceVariableNames:'package projectDefinitionClass sourceCodeManager buildDirectory
cg@2598
     5
		myWorkingDirectory mySTXTopDirectory myTopDirectory'
cg@2596
     6
	classVariableNames:'PreviousBuildDirectory'
cg@2596
     7
	poolDictionaries:''
cg@2596
     8
	category:'System-Support-Projects'
cg@2596
     9
!
cg@2596
    10
cg@2596
    11
cg@2596
    12
!ProjectBuilder class methodsFor:'examples'!
cg@2596
    13
cg@2596
    14
example1
cg@2596
    15
    Smalltalk loadPackage:'stx:projects/helloWorldApp' asAutoloaded:true.
cg@2596
    16
cg@2596
    17
    self new
cg@2596
    18
        package:'stx:projects/helloWorldApp';
cg@2596
    19
        build
cg@2596
    20
! !
cg@2596
    21
cg@2596
    22
!ProjectBuilder methodsFor:'accessing'!
cg@2596
    23
cg@2596
    24
package:aPackageIDOrSymbol
cg@2596
    25
    package := aPackageIDOrSymbol asPackageId.
cg@2596
    26
!
cg@2596
    27
cg@2596
    28
projectDefinitionClass:something
cg@2596
    29
    projectDefinitionClass := something.
cg@2596
    30
! !
cg@2596
    31
cg@2596
    32
!ProjectBuilder methodsFor:'building'!
cg@2596
    33
cg@2596
    34
build
cg@2596
    35
    "/ intermediate - this will move into a commonly used utility class
cg@2596
    36
    "/ (where all the project code support will be collected).
cg@2596
    37
cg@2596
    38
    |module directory|
cg@2596
    39
cg@2596
    40
    projectDefinitionClass := ProjectDefinition definitionClassForPackage:package.
cg@2596
    41
    projectDefinitionClass isNil ifTrue:[
cg@2596
    42
        self error:('Missing ProjectDefinition class for "',package asString,'"')
cg@2596
    43
    ].
cg@2596
    44
cg@2596
    45
    "/ ensure that everything is loaded...
cg@2596
    46
    projectDefinitionClass loadAsAutoloaded:false.
cg@2596
    47
    projectDefinitionClass loadExtensions.
cg@2596
    48
    projectDefinitionClass loadAllClassesAsAutoloaded:false.
cg@2596
    49
cg@2596
    50
    module := package module.
cg@2596
    51
    directory := package directory.
cg@2596
    52
cg@2596
    53
    buildDirectory := PreviousBuildDirectory ifNil:[ UserPreferences current buildDirectory ].
cg@2596
    54
    buildDirectory isNil ifTrue:[
cg@2596
    55
        buildDirectory := Filename tempDirectory construct:'stx_build'.
cg@2596
    56
    ].
cg@2596
    57
    buildDirectory := buildDirectory asFilename.
cg@2596
    58
cg@2596
    59
    "/ self validateBuildDirectoryIsPresent.
cg@2596
    60
cg@2596
    61
    PreviousBuildDirectory := buildDirectory.
cg@2596
    62
cg@2596
    63
    "/ UserPreferences current localBuild:true
cg@2596
    64
    UserPreferences current localBuild ifFalse:[
cg@2596
    65
        SourceCodeManager notNil ifTrue:[
cg@2596
    66
            sourceCodeManager := SourceCodeManagerUtilities sourceCodeManagerFor:projectDefinitionClass.
cg@2596
    67
        ]
cg@2596
    68
    ].
cg@2596
    69
    sourceCodeManager := nil.
cg@2596
    70
cg@2598
    71
    myTopDirectory := 
cg@2596
    72
        Smalltalk packagePath 
cg@2596
    73
            detect:[:aPath |
cg@2596
    74
                (aPath asFilename / 'stx' / 'include') exists
cg@2596
    75
                and: [ (aPath asFilename / 'stx' / 'rules') exists ]]
cg@2596
    76
            ifNone:nil.       
cg@2598
    77
    myTopDirectory isNil ifTrue:[
cg@2598
    78
        self error:('Cannot figure out my top directory (where stx/include and stx/rules are)')
cg@2596
    79
    ].
cg@2598
    80
    myTopDirectory := myTopDirectory asFilename.
cg@2598
    81
    mySTXTopDirectory := myTopDirectory / 'stx'.
cg@2596
    82
cg@2596
    83
    self setupBuildDirectory.
cg@2596
    84
    self generateSourceFiles.
cg@2598
    85
self halt.
cg@2596
    86
cg@2596
    87
    OperatingSystem
cg@2596
    88
        executeCommand:(ParserFlags makeCommand)
cg@2596
    89
        inputFrom:nil
cg@2596
    90
        outputTo:Transcript
cg@2596
    91
        errorTo:Transcript
cg@2596
    92
        inDirectory:((buildDirectory construct:module) construct:directory)
cg@2596
    93
        onError:[:status| self error:'make failed'].
cg@2596
    94
cg@2596
    95
    "Created: / 09-08-2006 / 18:37:19 / fm"
cg@2596
    96
    "Modified: / 09-08-2006 / 19:55:50 / fm"
cg@2596
    97
    "Modified: / 22-09-2006 / 17:37:11 / cg"
cg@2596
    98
!
cg@2596
    99
cg@2596
   100
copyDirectory:relativepath
cg@2596
   101
    "/ need rules in stx
cg@2596
   102
    ((Smalltalk projectDirectoryForPackage:'stx') asFilename construct:relativepath)
cg@2596
   103
        recursiveCopyTo:(buildDirectory construct:'stx').
cg@2596
   104
!
cg@2596
   105
cg@2596
   106
copyDirectoryForBuild:subdir
cg@2598
   107
    |targetDir targetFile|
cg@2596
   108
cg@2596
   109
    targetDir := buildDirectory / 'stx' / subdir.
cg@2596
   110
    targetDir exists ifFalse:[
cg@2596
   111
        targetDir makeDirectory.
cg@2598
   112
    ].
cg@2598
   113
    (mySTXTopDirectory / subdir) directoryContentsAsFilenamesDo:[:eachFile |
cg@2598
   114
        eachFile isDirectory ifFalse:[
cg@2598
   115
            targetFile := targetDir / eachFile baseName.
cg@2598
   116
            (targetFile exists not
cg@2598
   117
            or:[ targetFile modificationTime < eachFile modificationTime ]) ifTrue:[
cg@2598
   118
                self activityNotification:'copying ',eachFile pathName,'...'.
cg@2596
   119
                eachFile copyTo:(targetDir construct:eachFile baseName)
cg@2596
   120
            ]
cg@2596
   121
        ].
cg@2596
   122
    ].
cg@2598
   123
    self activityNotification:nil
cg@2598
   124
!
cg@2598
   125
cg@2598
   126
createHeaderFileFor:aClass in:packageTargetDir
cg@2598
   127
    |instVarList classInstVarList classVarList bindings superclassFilename
cg@2598
   128
     template file newContents oldContents|
cg@2598
   129
cg@2598
   130
    instVarList := StringCollection new.
cg@2598
   131
    aClass instVarNames do:[:v |
cg@2598
   132
        instVarList add:('OBJ %1;' bindWith:v)
cg@2598
   133
    ].
cg@2598
   134
    classInstVarList := StringCollection new.
cg@2598
   135
    aClass class instVarNames do:[:v |
cg@2598
   136
(v includes:$_) ifTrue:[self halt].
cg@2598
   137
        classInstVarList add:('OBJ %1;' bindWith:v)
cg@2598
   138
    ].
cg@2598
   139
    classVarList := StringCollection new.
cg@2598
   140
    aClass classVarNames do:[:v |
cg@2598
   141
        classVarList add:('extern OBJ %1_%2;' bindWith:aClass name with:v)
cg@2598
   142
    ].
cg@2598
   143
cg@2598
   144
    bindings := Dictionary new.
cg@2598
   145
    bindings at:'ClassName' put:aClass name. 
cg@2598
   146
    aClass superclass isNil ifTrue:[
cg@2598
   147
        bindings at:'SuperclassName' put:'-'. 
cg@2598
   148
        bindings at:'SuperclassFileInclude' put:nil.
cg@2598
   149
    ] ifFalse:[
cg@2598
   150
        bindings at:'SuperclassName' put:aClass superclass name. 
cg@2598
   151
        bindings at:'SuperclassFileName' put:(superclassFilename := Smalltalk fileNameForClass:aClass superclass).
cg@2598
   152
        bindings at:'SuperclassFileInclude' put:('#include "%1.STH"' bindWith:superclassFilename).
cg@2598
   153
    ].
cg@2598
   154
    bindings at:'InstVarList' put:instVarList asString. 
cg@2598
   155
    bindings at:'ClassVarList' put:classVarList asString. 
cg@2598
   156
    bindings at:'ClassInstVarList' put:classInstVarList asString. 
cg@2598
   157
cg@2598
   158
    template := 
cg@2598
   159
'/* This file was generated by ProjectBuilder. */
cg@2598
   160
/* !!!!!!!! Do not change by hand !!!!!!!! */
cg@2598
   161
cg@2598
   162
/* Class: %(ClassName) */
cg@2598
   163
/* Superclass: %(SuperclassName) */
cg@2598
   164
cg@2598
   165
%(SuperclassFileInclude)
cg@2598
   166
cg@2598
   167
/* INDIRECTGLOBALS */
cg@2598
   168
#ifdef _HEADER_INST_
cg@2598
   169
%(InstVarList)
cg@2598
   170
#endif /* _HEADER_INST_ */
cg@2598
   171
cg@2598
   172
#ifdef _HEADER_CLASS_
cg@2598
   173
%(ClassVarList)
cg@2598
   174
#endif /* _HEADER_CLASS_ */
cg@2598
   175
cg@2598
   176
#ifdef _HEADER_CLASSINST_
cg@2598
   177
%(ClassInstVarList)
cg@2598
   178
#endif /* _HEADER_CLASSINST_ */
cg@2598
   179
'.
cg@2598
   180
    newContents := template bindWithArguments:bindings.
cg@2598
   181
    file := packageTargetDir asFilename / ((Smalltalk fileNameForClass:aClass),'.STH').
cg@2598
   182
    (file exists not
cg@2598
   183
    or:[ (oldContents := file contents) ~= newContents ]) ifTrue:[
cg@2598
   184
        file contents: newContents.
cg@2598
   185
    ].
cg@2596
   186
!
cg@2596
   187
cg@2596
   188
generateSourceFiles
cg@2596
   189
    sourceCodeManager notNil ifTrue:[
cg@2596
   190
        "/ check out / generate files there
cg@2596
   191
        self generateSourceFilesByCheckingOutUsing:sourceCodeManager
cg@2596
   192
    ] ifFalse:[
cg@2596
   193
        "/ local build
cg@2596
   194
        "/ fileout the project
cg@2596
   195
        self generateSourceFilesByFilingOut
cg@2596
   196
    ]
cg@2596
   197
!
cg@2596
   198
cg@2596
   199
generateSourceFilesByCheckingOutUsing:aSourceCodeManager
cg@2596
   200
    "/ will no longer be needed/supported
cg@2596
   201
cg@2596
   202
    |repository stxRepository module directory|
cg@2596
   203
cg@2596
   204
self halt.
cg@2596
   205
    "/ check out / generate files there
cg@2596
   206
    repository := (aSourceCodeManager repositoryNameForModule:module) ifNil:[aSourceCodeManager repositoryName].
cg@2596
   207
    stxRepository := aSourceCodeManager repositoryName.
cg@2596
   208
cg@2596
   209
    (buildDirectory construct:'stx') exists ifFalse:[
cg@2596
   210
        (module ~= 'stx') ifTrue:[
cg@2596
   211
            OperatingSystem
cg@2596
   212
                executeCommand:('cvs -d ',stxRepository,' co stx')
cg@2596
   213
                inputFrom:nil
cg@2596
   214
                outputTo:Transcript
cg@2596
   215
                errorTo:Transcript
cg@2596
   216
                inDirectory:buildDirectory
cg@2596
   217
                onError:[:status| self error:'cvs update stx failed'].
cg@2596
   218
        ].
cg@2596
   219
    ].
cg@2596
   220
cg@2596
   221
    ((buildDirectory construct:module) construct:'CVS') exists ifFalse:[
cg@2596
   222
        OperatingSystem
cg@2596
   223
            executeCommand:('cvs -d ',repository,' co -l ',directory)
cg@2596
   224
            inputFrom:nil
cg@2596
   225
            outputTo:Transcript
cg@2596
   226
            errorTo:Transcript
cg@2596
   227
            inDirectory:buildDirectory
cg@2596
   228
            onError:[:status| self error:'cvs update failed'].
cg@2596
   229
    ].
cg@2596
   230
    OperatingSystem
cg@2596
   231
        executeCommand:'cvs upd -d'
cg@2596
   232
        inputFrom:nil
cg@2596
   233
        outputTo:Transcript
cg@2596
   234
        errorTo:Transcript
cg@2596
   235
        inDirectory:(buildDirectory construct:module)
cg@2596
   236
        onError:[:status| self error:'cvs update failed'].
cg@2596
   237
self halt.
cg@2596
   238
!
cg@2596
   239
cg@2596
   240
generateSourceFilesByFilingOut
cg@2596
   241
    |targetDir prerequisitePackages|
cg@2596
   242
cg@2596
   243
    "/ local build
cg@2596
   244
    "/ fileout the project
cg@2596
   245
cg@2596
   246
    (package module ~= 'stx') ifTrue:[
cg@2596
   247
        (buildDirectory / package module) makeDirectory.
cg@2596
   248
    ].
cg@2596
   249
cg@2596
   250
    "/ file out the package(s)
cg@2598
   251
    ((Array with:package))
cg@2598
   252
    do:[:eachPackageToFileout |
cg@2598
   253
        |packageId packageModule packageDirectory packageTargetDir packageDef|
cg@2596
   254
cg@2598
   255
        packageId := eachPackageToFileout asPackageId.
cg@2598
   256
        packageModule := packageId module.
cg@2598
   257
        packageDirectory := packageId directory.
cg@2596
   258
        packageTargetDir := (buildDirectory / packageModule / packageDirectory) recursiveMakeDirectory.
cg@2596
   259
cg@2598
   260
        packageDef := packageId projectDefinitionClass.
cg@2598
   261
        (packageDef compiled_classNames_common ,
cg@2598
   262
        packageDef compiled_classNamesForPlatform) do:[:eachClassName |
cg@2598
   263
            |cls|
cg@2598
   264
cg@2598
   265
            cls := Smalltalk classNamed:eachClassName.
cg@2598
   266
            self assert:cls isLoaded.
cg@2598
   267
            cls fileOutIn:packageTargetDir
cg@2596
   268
        ].
cg@2598
   269
cg@2598
   270
"/        (Smalltalk allClassesInPackage:eachPackageToFileout) do:[:cls |
cg@2598
   271
"/            cls isPrivate ifFalse:[
cg@2598
   272
"/                cls isLoaded ifFalse:[
cg@2598
   273
"/                    self halt.
cg@2598
   274
"/                    cls autoload.
cg@2598
   275
"/                ].
cg@2598
   276
"/                cls fileOutIn:packageTargetDir
cg@2598
   277
"/            ]
cg@2598
   278
"/        ].
cg@2598
   279
    ].
cg@2598
   280
    "/ generate header files...
cg@2598
   281
    (projectDefinitionClass allPreRequisites)
cg@2598
   282
    do:[:eachPackageToFileout |
cg@2598
   283
        |packageId packageDef packageModule packageDirectory packageTargetDir|
cg@2598
   284
cg@2598
   285
        packageId := eachPackageToFileout asPackageId.
cg@2598
   286
        packageModule := packageId module.
cg@2598
   287
        packageDirectory := packageId directory.
cg@2598
   288
        packageTargetDir := (buildDirectory / packageModule / packageDirectory) recursiveMakeDirectory.
cg@2598
   289
cg@2598
   290
        packageDef := packageId projectDefinitionClass.
cg@2598
   291
        (packageDef compiled_classNames_common ,
cg@2598
   292
        packageDef compiled_classNamesForPlatform) do:[:eachClassName |
cg@2598
   293
            |cls|
cg@2598
   294
cg@2598
   295
            cls := Smalltalk classNamed:eachClassName.
cg@2598
   296
            self assert:cls isLoaded.
cg@2598
   297
            cls isLoaded ifTrue:[    
cg@2598
   298
                self createHeaderFileFor:cls in:packageTargetDir
cg@2598
   299
            ].
cg@2598
   300
        ].
cg@2598
   301
cg@2598
   302
"/        (Smalltalk allClassesInPackage:eachPackageToFileout) do:[:cls |
cg@2598
   303
"/            cls isPrivate ifFalse:[
cg@2598
   304
"/                cls isLoaded ifTrue:[
cg@2598
   305
"/                    self createHeaderFileFor:cls in:packageTargetDir
cg@2598
   306
"/                ]
cg@2598
   307
"/            ]
cg@2598
   308
"/        ].
cg@2596
   309
    ].
cg@2596
   310
cg@2596
   311
"/    "/ copy h-files preRequisite packages
cg@2596
   312
"/    prerequisitePackages := projectDefinitionClass preRequisitesForBuilding.
cg@2596
   313
"/    prerequisitePackages do:[:eachPackage |
cg@2596
   314
"/        |relativeDir sourceDir|
cg@2596
   315
"/
cg@2596
   316
"/        relativeDir := eachPackage asPackageId pathRelativeToTopDirectory.
cg@2596
   317
"/        sourceDir := Smalltalk packageDirectoryForPackageId:eachPackage.
cg@2596
   318
"/        targetDir := buildDirectory construct:relativeDir.
cg@2596
   319
"/        targetDir recursiveMakeDirectory.
cg@2596
   320
"/        sourceDir directoryContentsAsFilenamesDo:[:eachSourceFilename |
cg@2596
   321
"/            ((eachSourceFilename suffix asLowercase = 'h')
cg@2596
   322
"/            or:[ eachSourceFilename suffix asLowercase = 'sth' ]) ifTrue:[
cg@2596
   323
"/                eachSourceFilename copyTo:targetDir.    
cg@2596
   324
"/            ].
cg@2596
   325
"/        ].
cg@2596
   326
"/    ].
cg@2596
   327
cg@2596
   328
"/    stx_libbasic2 preRequisitesForBuilding#(#'stx:libbasic')
cg@2596
   329
"/    "/ generate support files there
cg@2596
   330
"/    targetDir := ((buildDirectory construct:module) construct:directory) recursiveMakeDirectory.
cg@2596
   331
"/    #('bmake.bat' 'Make.spec' 'Make.proto' 'libInit.cc' 'abbrev.stc'
cg@2596
   332
"/      'bc.mak'
cg@2596
   333
"/    ) do:[:f |
cg@2596
   334
"/        |contents|                          
cg@2596
   335
"/
cg@2596
   336
"/        contents := projectDefinitionClass generateFile:f.
cg@2596
   337
"/        (targetDir construct:f) contents:contents.
cg@2596
   338
"/    ].    
cg@2596
   339
!
cg@2596
   340
cg@2596
   341
setupBuildDirectory
cg@2596
   342
    buildDirectory exists ifFalse:[
cg@2596
   343
        buildDirectory recursiveMakeDirectory.
cg@2596
   344
    ].
cg@2596
   345
    (buildDirectory / 'stx') exists ifFalse:[
cg@2596
   346
        (buildDirectory / 'stx') makeDirectory.
cg@2596
   347
    ].
cg@2596
   348
cg@2596
   349
    self copyDirectoryForBuild:'include'.
cg@2596
   350
    self copyDirectoryForBuild:'rules'.
cg@2596
   351
!
cg@2596
   352
cg@2596
   353
validateBuildDirectoryIsPresent
cg@2596
   354
cg@2596
   355
    ^ self.
cg@2596
   356
cg@2596
   357
"/    [
cg@2596
   358
"/        |default directoryIsOKForMe stc |
cg@2596
   359
"/
cg@2596
   360
"/        default := (buildDirectory ?
cg@2596
   361
"/                          PreviousBuildDirectory)
cg@2596
   362
"/                          ifNil:[ UserPreferences current buildDirectory].
cg@2596
   363
"/
cg@2596
   364
"/        buildDirectory := Dialog requestDirectoryName:'Temporary Work-ROOT for build:'
cg@2596
   365
"/                                 default:default.
cg@2596
   366
"/
cg@2596
   367
"/        buildDirectory isEmptyOrNil ifTrue:[^ self].
cg@2596
   368
"/        buildDirectory := buildDirectory asFilename.
cg@2596
   369
"/        directoryIsOKForMe := true.
cg@2596
   370
"/
cg@2596
   371
"/        buildDirectory exists ifFalse:[
cg@2596
   372
"/            Dialog warn:(self classResources string:'Work directory %1 does not exist.' with:buildDirectory).
cg@2596
   373
"/            directoryIsOKForMe := false.
cg@2596
   374
"/        ] ifTrue:[
cg@2596
   375
"/            (buildDirectory construct:'stx') exists ifFalse:[
cg@2596
   376
"/                Dialog warn:(self classResources stringWithCRs:'Work directory must contain an stx subDirectory,\which contains (at least) the stc and include subdirectories.').
cg@2596
   377
"/                directoryIsOKForMe := false.
cg@2596
   378
"/            ] ifTrue:[
cg@2596
   379
"/                stc := (OperatingSystem isMSDOSlike) ifTrue:['stc.exe'] ifFalse:['stc'].
cg@2596
   380
"/                (((buildDirectory construct:'stx')construct:'stc')construct:stc) exists ifFalse:[
cg@2596
   381
"/                    Dialog warn:(self classResources stringWithCRs:'Work directory must contain an stc compiler in the stx/stc subDirectory.').
cg@2596
   382
"/                    directoryIsOKForMe := false.
cg@2596
   383
"/                ].
cg@2596
   384
"/                ((buildDirectory construct:'stx')construct:'include') exists ifFalse:[
cg@2596
   385
"/                    Dialog warn:(self classResources stringWithCRs:'Work directory must have had a make run before (for include files to exists).').
cg@2596
   386
"/                    directoryIsOKForMe := false.
cg@2596
   387
"/                ].
cg@2596
   388
"/            ]
cg@2596
   389
"/        ].
cg@2596
   390
"/        directoryIsOKForMe
cg@2596
   391
"/    ] whileFalse
cg@2596
   392
! !
cg@2596
   393
cg@2596
   394
!ProjectBuilder class methodsFor:'documentation'!
cg@2596
   395
cg@2596
   396
version_CVS
cg@2596
   397
    ^ '$Header$'
cg@2596
   398
! !