hg/stx-libbasic: comparison ProjectDefinition.st

equal deleted inserted replaced

-:72c87816423e
+:69b2dbff964b
 ! !
 !ProjectDefinition class methodsFor:'code generation'!
 classNamesAndAttributes_code_ignoreOldDefinition:ignoreOldDefinition
+"generate method code returning all classes of the project.
+Platform attributes are kept from the old definition.
+If ignoreOldDefinition is true, the autoload attribute is set/reset if
+the class is installed as autoloaded in the image. If false, it is taken
+from an existing definition in #classNamesAndAttributes"
 ^ String streamContents:[:s |
+|oldSpec|
+oldSpec := self classNamesAndAttributes.
 s nextPutLine:'classNamesAndAttributes'.
+s tab; nextPutLine:'"<className> or (<className> attributes...) in load order"'; cr.
 s nextPutLine:'    ^ #('.
-s tab; nextPutLine:'"/ <className> or (<className> attributes...)'.
 self searchForClasses do:[:eachClass |
-|oldSpec attributes oldSpecEntry|
+|attributes oldSpecEntry|
-oldSpec := self classNamesAndAttributes.
 (eachClass isLoaded not or:[eachClass isPrivate not]) ifTrue:[
 oldSpecEntry := oldSpec detect:[:entry | entry first = eachClass name] ifNone:nil.
 ignoreOldDefinition ifTrue:[
-"/ take autoload attribute from current state
+"take autoload attribute from classes state in the image"
 oldSpecEntry notNil ifTrue:[
 attributes := oldSpecEntry copyFrom:2.
 attributes := attributes copyWithout:#autoload.
 ] ifFalse:[
 attributes := #()
 ].
 eachClass isLoaded ifFalse:[
-attributes isEmpty ifTrue:[
+attributes := attributes copyWith:#autoload.
-attributes := attributes , #( autoload ).
-]
 ].
 ] ifFalse:[
-"/ keep any existing attribute
+"keep any existing attribute"
 oldSpecEntry notNil ifTrue:[
 attributes := oldSpecEntry copyFrom:2.
 ] ifFalse:[
-attributes := eachClass isLoaded ifTrue:[ #() ] ifFalse:[ #( autoload ) ].
+attributes := eachClass isLoaded ifTrue:[ #() ] ifFalse:[ #(autoload) ].
 ].
 ].
-s tab.
+s tab; tab.
 attributes isEmptyOrNil ifTrue:[
-s nextPutAll:eachClass name asString storeString.
+eachClass name printOn:s.
 ] ifFalse:[
-s nextPutAll:'('; nextPutAll:eachClass name asString storeString.
+s nextPut:$(. eachClass name printOn:s.
-attributes do:[:eachAttribute | s nextPutAll:' '. s nextPutAll:eachAttribute storeString.].
+attributes do:[:eachAttribute | s space. eachAttribute printOn:s.].
-s nextPutAll:')'.
+s nextPut:$).
 ].
 s cr.
 ]
 ].
 s nextPutLine:'    )'
 ].
 "
-stx_libbasic3 classNamesAndAttributes_code
+stx_libbasic3 classNamesAndAttributes_code_ignoreOldDefinition:true
 "
 "Modified: / 08-08-2006 / 19:24:34 / fm"
 "Created: / 17-08-2006 / 21:03:07 / cg"
 "Modified: / 19-09-2006 / 17:14:17 / cg"
 streamContents:[:s |
 |classNames classesLoaded classNamesUnloaded classesSorted classNamesSorted|
 classNames := self compiled_classNames_common.
 classesLoaded := classNames
-collect:[:nm | |cls| cls := Smalltalk classNamed:nm]
+collect:[:nm | Smalltalk classNamed:nm]
 thenSelect:[:cls |  cls notNil and:[cls isLoaded] ].
 classNamesUnloaded := classNames
 select:[:nm | |cls| cls := Smalltalk classNamed:nm. cls isNil or:[cls isLoaded not]].
 classesSorted := Class classesSortedByLoadOrder:classesLoaded.
-classNamesSorted := classesSorted collect:[:cls |cls name].
+classNamesSorted := classesSorted collect:[:cls | cls name].
 s nextPutAll:'"/
 "/ $' , 'Header' , '$
 "/
 mappings := self classLine_mappings:className.
 newClassLine := self replaceMappings:mappings in:classLineTemplate.
 s nextPutLine:newClassLine
 ].
 classNames := self compiled_classNames_common.
-classesLoaded := classNames
+classesLoaded := classNames collect:[:eachClassName | Smalltalk classNamed:eachClassName]
-collect:[:nm |
+thenSelect:[:eachClass | eachClass notNil and:[eachClass isLoaded]].
-|cls|
-cls := Smalltalk classNamed:nm
-]
-thenSelect:[:cls | cls notNil and:[ cls isLoaded ] ].
 classNamesUnloaded := classNames
 select:[:nm |
 |cls|
 cls := Smalltalk classNamed:nm.
 cls isNil or:[ cls isLoaded not ]
 ].
-classNamesSorted := (Class classesSortedByLoadOrder:classesLoaded)
+classNamesSorted := (Class classesSortedByLoadOrder:classesLoaded) collect:[:cls | cls name].
-collect:[:cls | cls name ].
 classNamesSorted do:putLineForClassName.
 classNamesUnloaded do:putLineForClassName.
 self namesAndAttributesIn:(self additionalClassNamesAndAttributes)
 do:[:nm :attr |
 (attr isEmptyOrNil or:[ (attr includes:#autoload) not ]) ifTrue:[
 putLineForClassName value:nm.
 ].
 ].
-#( #('UNIX' unix)
+#( ('UNIX' unix)
-#('WIN32' win32)
+('WIN32' win32)
-#('VMS' vms)
+('VMS' vms)
-#('BEOS' beos) )
+('BEOS' beos) )
-pairsDo:[:ifdef :id |
+pairsDo:[:ifdef :platformName |
 |archClassNames archClassesLoaded|
-archClassNames := self compiled_classNamesForPlatform:id.
+archClassNames := self compiled_classNamesForPlatform:platformName.
 archClassNames notEmpty ifTrue:[
 s nextPutLine:'#ifdef ' , ifdef.
 archClassNames do:[:clsName |
 putLineForClassName value:clsName
 ].
 ]
 "
 bosch_dapasx_datenbasis  generateClassLines_libInit_dot_cc
 bosch_dapasx_kernel  generateClassLines_libInit_dot_cc
-stx_libbasic3 generateClassLines_libInit_dot_cc"
+stx_libbasic3 generateClassLines_libInit_dot_cc
+"
 "Modified: / 16-08-2006 / 18:52:10 / User"
 "Created: / 19-09-2006 / 22:47:50 / cg"
 "Modified: / 20-09-2006 / 11:47:25 / cg"
 !
 s nextPutAll:' $(STCHDR)'.
 s cr.
 ].
 classNames := self compiled_classNames_common.
 classesLoaded := classNames
-collect:[:className |
+collect:[:className | Smalltalk classNamed:className]
-|cls|
+thenSelect:[:cls | cls notNil and:[cls isLoaded]].
-cls := Smalltalk classNamed:className
-]
-thenSelect:[:cls | cls notNil and:[ cls isLoaded ] ].
 classesSorted := Class classesSortedByLoadOrder:classesLoaded.
 classesSorted do:putDependencyForClass.
 self namesAndAttributesIn:(self additionalClassNamesAndAttributes)
 do:[:className :attr |
 |cls|
 ]
 ].
 ].
 archClassNames := self compiled_classNamesForPlatform:whichArchitecture.
 archClassesLoaded := archClassNames
-collect:[:className |
+collect:[:className | Smalltalk classNamed:className]
-|cls|
-cls := Smalltalk classNamed:className
-]
 thenSelect:[:cls | cls notNil and:[ cls isLoaded ] ].
 archClassesLoaded notEmpty ifTrue:[
-(Class classesSortedByLoadOrder:archClassesLoaded)
+(Class classesSortedByLoadOrder:archClassesLoaded) do:putDependencyForClass.
-do:putDependencyForClass.
 ].
 self hasExtensionMethods ifTrue:putDependencyForExtensions.
 ]
 "
 stx_libbasic3 generateDependencies:#unix
-stx_libbasic3 generateDependencies:#win32"
+stx_libbasic3 generateDependencies:#win32
+"
 "Modified: / 16-08-2006 / 18:52:10 / User"
 "Created: / 14-09-2006 / 12:38:57 / cg"
 "Modified: / 14-09-2006 / 17:04:21 / cg"
 !
 "Created: / 22-08-2006 / 18:20:09 / cg"
 !
 searchForClasses
-"answer all classes that belong to this project.
+"answer all non-private classes that belong to this project.
 They are sorted in load order"
 ^ Class classesSortedByLoadOrder:(self searchForClassesWithProject: self package)
 "
-self searchForClasses
+stx_libbasic3 searchForClasses
 "
 "Modified: / 07-08-2006 / 21:56:25 / fm"
 "Created: / 17-08-2006 / 21:18:30 / cg"
 !
 ! !
 !ProjectDefinition class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.81 2006-09-22 16:47:25 stefan Exp $'
+^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.82 2006-09-25 19:18:01 stefan Exp $'
 ! !
 ProjectDefinition initialize!

changeset 10010	69b2dbff964b
parent 10007	93f73465ef11
child 10011	4df81726da18