--- a/ProjectDefinition.st Wed Sep 14 15:39:47 2011 +0200
+++ b/ProjectDefinition.st Wed Sep 14 15:48:16 2011 +0200
@@ -229,7 +229,7 @@
"answer all (recursive) prerequisite project ids of myself - in random order."
^ self allPreRequisitesWithParentDo:[:parent :prereq |
- prereq = self package ifTrue:[ Transcript showCR:('oops: %1 depends on itself' bindWith:prereq) ].
+ prereq = self package ifTrue:[ Transcript showCR:('oops: %1 depends on itself' bindWith:prereq) ].
]
"
@@ -302,7 +302,7 @@
allPreRequisitesWithParentDo:aBlock
"answer all (recursive) prerequisite project ids of myself - in random order.
- If we exclude a project, but one of our prerequisite projects depends on it,
+ If we exclude a project, but one of our prerequisite projects depends on it,
then what ????"
|setOfAllPreRequisites toAdd|
@@ -318,34 +318,34 @@
"/ toAdd addAll:self effectiveSubProjects.
[toAdd notEmpty] whileTrue:[
- |aPreRequisiteProjectID def|
-
- aPreRequisiteProjectID := toAdd removeFirst.
- (setOfAllPreRequisites includes:aPreRequisiteProjectID) ifFalse:[
- setOfAllPreRequisites add:aPreRequisiteProjectID.
-
- def := self definitionClassForPackage:aPreRequisiteProjectID.
- def isNil ifTrue:[
- Transcript showCR:'ProjectDefinition ', aPreRequisiteProjectID, ' is missing - cannot find its preRequisites.'.
- ] ifFalse:[
- def effectivePreRequisites
- select:[:eachSubPreRequisite | (setOfAllPreRequisites includes:eachSubPreRequisite) not]
- thenDo:[:eachSubPreRequisite |
- Transcript show:'ProjectDefinition preRequisites: '; showCR:(aPreRequisiteProjectID, ' requires ', eachSubPreRequisite).
- aBlock value:def value:eachSubPreRequisite.
- toAdd add:eachSubPreRequisite
- ].
-
- "but subprojects of our prerequisites are also prerequisites"
- def effectiveSubProjects
- select:[:eachSubSubRequisite | eachSubSubRequisite ~= self package and:[ (setOfAllPreRequisites includes:eachSubSubRequisite) not ]]
- thenDo:[:eachSubSubRequisite |
- Transcript show:'ProjectDefinition preRequisites: '; showCR:(aPreRequisiteProjectID, ' hasSub ', eachSubSubRequisite).
- aBlock value:def value:eachSubSubRequisite.
- toAdd add:eachSubSubRequisite
- ].
- ].
- ]
+ |aPreRequisiteProjectID def|
+
+ aPreRequisiteProjectID := toAdd removeFirst.
+ (setOfAllPreRequisites includes:aPreRequisiteProjectID) ifFalse:[
+ setOfAllPreRequisites add:aPreRequisiteProjectID.
+
+ def := self definitionClassForPackage:aPreRequisiteProjectID.
+ def isNil ifTrue:[
+ Transcript showCR:'ProjectDefinition ', aPreRequisiteProjectID, ' is missing - cannot find its preRequisites.'.
+ ] ifFalse:[
+ def effectivePreRequisites
+ select:[:eachSubPreRequisite | (setOfAllPreRequisites includes:eachSubPreRequisite) not]
+ thenDo:[:eachSubPreRequisite |
+ Transcript show:'ProjectDefinition preRequisites: '; showCR:(aPreRequisiteProjectID, ' requires ', eachSubPreRequisite).
+ aBlock value:def value:eachSubPreRequisite.
+ toAdd add:eachSubPreRequisite
+ ].
+
+ "but subprojects of our prerequisites are also prerequisites"
+ def effectiveSubProjects
+ select:[:eachSubSubRequisite | eachSubSubRequisite ~= self package and:[ (setOfAllPreRequisites includes:eachSubSubRequisite) not ]]
+ thenDo:[:eachSubSubRequisite |
+ Transcript show:'ProjectDefinition preRequisites: '; showCR:(aPreRequisiteProjectID, ' hasSub ', eachSubSubRequisite).
+ aBlock value:def value:eachSubSubRequisite.
+ toAdd add:eachSubSubRequisite
+ ].
+ ].
+ ]
].
^ setOfAllPreRequisites.
@@ -1113,19 +1113,19 @@
|suite classes|
suite := TestSuite named:self package.
- classes := self classes
- select:[:each |
- each isLoaded ifFalse:[each autoload].
- (each isTestCaseLike) and:[ each isAbstract not ]
- ].
+ classes := self classes
+ select:[:each |
+ each isLoaded ifFalse:[each autoload].
+ (each isTestCaseLike) and:[ each isAbstract not ]
+ ].
classes := classes asSortedCollection:[:a :b | a name <= b name ].
- classes do: [:eachClass |
- | tests |
-
- tests := eachClass suite tests.
- tests := tests reject:[:test|self shouldExcludeTest: test].
- suite addTests: tests
+ classes do: [:eachClass |
+ | tests |
+
+ tests := eachClass suite tests.
+ tests := tests reject:[:test|self shouldExcludeTest: test].
+ suite addTests: tests
].
^ suite
@@ -1153,18 +1153,18 @@
"needs everything else (especially the compiler etc.) to be initialized.
Therefore, its not invoked by #initialize, but instead explicitely,
by Smalltalk"
-
+
|isStandAloneApp|
isStandAloneApp := Smalltalk isStandAloneApp.
self allSubclassesDo:[:eachProjectDefinitionClass |
- eachProjectDefinitionClass isAbstract ifFalse:[
- isStandAloneApp ifFalse:[
- eachProjectDefinitionClass installAutoloadedClasses.
- ].
- eachProjectDefinitionClass projectIsLoaded:true.
- ]
+ eachProjectDefinitionClass isAbstract ifFalse:[
+ isStandAloneApp ifFalse:[
+ eachProjectDefinitionClass installAutoloadedClasses.
+ ].
+ eachProjectDefinitionClass projectIsLoaded:true.
+ ]
].
"
@@ -1182,62 +1182,62 @@
classesToFixClassFileName := OrderedCollection new.
self autoloaded_classNames do:[:className |
- |cls|
-
- "/ 'install as autoloaded: ' errorPrint. className errorPrintCR.
- (cls := Smalltalk classNamed:className) isNil ifTrue:[
- Error handle:[:ex |
- (self name,' [warning]: failed to install autoloaded: ',className) errorPrintCR.
- (self name,' [info]: reason: ',ex description) errorPrintCR.
- "/ thisContext fullPrintAll.
- ] do:[
- cls := Smalltalk
- installAutoloadedClassNamed:className
- category:'* as yet unknown category *'
- package:self package
- revision:nil
- ].
- cls notNil ifTrue:[
- classesToFixClassFileName add:cls.
- ].
- ].
+ |cls|
+
+ "/ 'install as autoloaded: ' errorPrint. className errorPrintCR.
+ (cls := Smalltalk classNamed:className) isNil ifTrue:[
+ Error handle:[:ex |
+ (self name,' [warning]: failed to install autoloaded: ',className) errorPrintCR.
+ (self name,' [info]: reason: ',ex description) errorPrintCR.
+ "/ thisContext fullPrintAll.
+ ] do:[
+ cls := Smalltalk
+ installAutoloadedClassNamed:className
+ category:'* as yet unknown category *'
+ package:self package
+ revision:nil
+ ].
+ cls notNil ifTrue:[
+ classesToFixClassFileName add:cls.
+ ].
+ ].
].
Smalltalk addStartBlock:[
- |abbrevs|
-
- abbrevs := self abbrevs.
- "/ patch the classFileNames
- classesToFixClassFileName do:[:cls |
- |entry classFilenameFromAbbreviations|
-
- entry := abbrevs at:cls name ifAbsent:nil.
- entry notNil ifTrue:[
- classFilenameFromAbbreviations := entry fileName.
- classFilenameFromAbbreviations notNil ifTrue:[
- classFilenameFromAbbreviations := classFilenameFromAbbreviations,'.st'.
- (classFilenameFromAbbreviations ~= cls getClassFilename) ifTrue:[
- cls setClassFilename:classFilenameFromAbbreviations
- ].
- ].
- ]
- ].
-
- "/ patch the categories
- Class withoutUpdatingChangesDo:[
- |entry|
-
- self classNames do:[:nm |
- |cls|
-
- ((cls := Smalltalk at: nm) notNil
- and:[ cls isLoaded not
- and:[ (entry := abbrevs at:cls name ifAbsent:[nil]) notNil
- ]]) ifTrue:[
- cls category: (entry category)
- ]
- ]
- ]
+ |abbrevs|
+
+ abbrevs := self abbrevs.
+ "/ patch the classFileNames
+ classesToFixClassFileName do:[:cls |
+ |entry classFilenameFromAbbreviations|
+
+ entry := abbrevs at:cls name ifAbsent:nil.
+ entry notNil ifTrue:[
+ classFilenameFromAbbreviations := entry fileName.
+ classFilenameFromAbbreviations notNil ifTrue:[
+ classFilenameFromAbbreviations := classFilenameFromAbbreviations,'.st'.
+ (classFilenameFromAbbreviations ~= cls getClassFilename) ifTrue:[
+ cls setClassFilename:classFilenameFromAbbreviations
+ ].
+ ].
+ ]
+ ].
+
+ "/ patch the categories
+ Class withoutUpdatingChangesDo:[
+ |entry|
+
+ self classNames do:[:nm |
+ |cls|
+
+ ((cls := Smalltalk at: nm) notNil
+ and:[ cls isLoaded not
+ and:[ (entry := abbrevs at:cls name ifAbsent:[nil]) notNil
+ ]]) ifTrue:[
+ cls category: (entry category)
+ ]
+ ]
+ ]
].
@@ -1317,76 +1317,76 @@
newSpec := OrderedCollection new.
ignoreOldEntries ifFalse:[
- oldSpec do:[:oldEntry |
- |newEntry className cls |
-
- newEntry := oldEntry copy.
- className := newEntry first.
-
- (ignored includes:className) ifFalse:[
- cls := Smalltalk classNamed:className.
- ignoreOldDefinition ifTrue:[
- (cls notNil and:[cls isLoaded not]) ifTrue:[
- (newEntry includes:#autoload) ifFalse:[
- newEntry := newEntry copyWith:#autoload.
- ].
- ].
- ].
- cls notNil ifTrue:[
- "JV @ 2010-06-19
- Force merge default class attributes with existing ones"
- newEntry := self mergeDefaultClassAttributesFor: cls with: newEntry.
- newSpec add:newEntry.
- ]
- ].
- ].
+ oldSpec do:[:oldEntry |
+ |newEntry className cls |
+
+ newEntry := oldEntry copy.
+ className := newEntry first.
+
+ (ignored includes:className) ifFalse:[
+ cls := Smalltalk classNamed:className.
+ ignoreOldDefinition ifTrue:[
+ (cls notNil and:[cls isLoaded not]) ifTrue:[
+ (newEntry includes:#autoload) ifFalse:[
+ newEntry := newEntry copyWith:#autoload.
+ ].
+ ].
+ ].
+ cls notNil ifTrue:[
+ "JV @ 2010-06-19
+ Force merge default class attributes with existing ones"
+ newEntry := self mergeDefaultClassAttributesFor: cls with: newEntry.
+ newSpec add:newEntry.
+ ]
+ ].
+ ].
].
self searchForClasses do:[:eachClass |
- |className attributes oldSpecEntry oldAttributes newEntry|
-
- className := eachClass name.
- (ignored includes:className) ifFalse:[
- oldSpecEntry := oldSpec detect:[:entry | entry first = className] ifNone:nil.
-
- (ignoreOldEntries or:[ oldSpecEntry isNil]) ifTrue:[
- (eachClass isLoaded not or:[eachClass isPrivate not]) ifTrue:[
- (self additionalClassNamesAndAttributes includes:className) ifFalse:[
- (oldSpecEntry size > 1) ifTrue:[
- oldAttributes := oldSpecEntry copyFrom:2.
- ].
-
- ignoreOldDefinition ifTrue:[
- "take autoload attribute from classes state in the image"
- oldAttributes notNil ifTrue:[
- attributes := oldAttributes copyWithout:#autoload.
- ] ifFalse:[
- attributes := #()
- ].
- eachClass isLoaded ifFalse:[
- attributes := attributes copyWith:#autoload.
- ].
- ] ifFalse:[
- "keep any existing attribute"
- oldAttributes notNil ifTrue:[
- attributes := oldAttributes.
- ] ifFalse:[
- attributes := eachClass isLoaded ifTrue:[ #() ] ifFalse:[ #(autoload) ].
- ].
- ].
- "JV @ 2010-06-19
- Support fo additional class attributes and programming language attribute"
- attributes := self mergeDefaultClassAttributesFor: eachClass with: attributes.
-
- newEntry := Array with:className.
- attributes notEmptyOrNil ifTrue:[
- newEntry := newEntry , attributes.
- ].
- newSpec add:newEntry
- ]
- ]
- ]
- ]
+ |className attributes oldSpecEntry oldAttributes newEntry|
+
+ className := eachClass name.
+ (ignored includes:className) ifFalse:[
+ oldSpecEntry := oldSpec detect:[:entry | entry first = className] ifNone:nil.
+
+ (ignoreOldEntries or:[ oldSpecEntry isNil]) ifTrue:[
+ (eachClass isLoaded not or:[eachClass isPrivate not]) ifTrue:[
+ (self additionalClassNamesAndAttributes includes:className) ifFalse:[
+ (oldSpecEntry size > 1) ifTrue:[
+ oldAttributes := oldSpecEntry copyFrom:2.
+ ].
+
+ ignoreOldDefinition ifTrue:[
+ "take autoload attribute from classes state in the image"
+ oldAttributes notNil ifTrue:[
+ attributes := oldAttributes copyWithout:#autoload.
+ ] ifFalse:[
+ attributes := #()
+ ].
+ eachClass isLoaded ifFalse:[
+ attributes := attributes copyWith:#autoload.
+ ].
+ ] ifFalse:[
+ "keep any existing attribute"
+ oldAttributes notNil ifTrue:[
+ attributes := oldAttributes.
+ ] ifFalse:[
+ attributes := eachClass isLoaded ifTrue:[ #() ] ifFalse:[ #(autoload) ].
+ ].
+ ].
+ "JV @ 2010-06-19
+ Support fo additional class attributes and programming language attribute"
+ attributes := self mergeDefaultClassAttributesFor: eachClass with: attributes.
+
+ newEntry := Array with:className.
+ attributes notEmptyOrNil ifTrue:[
+ newEntry := newEntry , attributes.
+ ].
+ newSpec add:newEntry
+ ]
+ ]
+ ]
+ ]
].
^ self classNamesAndAttributes_codeFor:newSpec
@@ -2052,18 +2052,18 @@
generate a rule to create the header file only."
^ String streamContents:[:s |
- (self extensionClassesWithSuperclasses:true) do:[:eachExtendedClass |
- |headerFileDirPath baseFilename|
-
- (eachExtendedClass isLoaded not or:[eachExtendedClass wasAutoloaded]) ifTrue:[
- headerFileDirPath := self perform:pathConverter with:eachExtendedClass package.
- baseFilename := self filenameForClass:eachExtendedClass.
-
- s nextPutAll:(template
- bindWith:headerFileDirPath
- with:baseFilename).
- ]
- ].
+ (self extensionClassesWithSuperclasses:true) do:[:eachExtendedClass |
+ |headerFileDirPath baseFilename|
+
+ (eachExtendedClass isLoaded not or:[eachExtendedClass wasAutoloaded]) ifTrue:[
+ headerFileDirPath := self perform:pathConverter with:eachExtendedClass package.
+ baseFilename := self filenameForClass:eachExtendedClass.
+
+ s nextPutAll:(template
+ bindWith:headerFileDirPath
+ with:baseFilename).
+ ]
+ ].
].
"Created: / 12-09-2011 / 16:23:52 / cg"
@@ -2072,9 +2072,9 @@
additionalHeaderRules_bc_dot_mak
"rules for header files (of autoloaded classes)"
- ^ self
- additionalHeaderRulesUsingTemplate:(self singleHeaderRuleTemplate_bc_dot_mak)
- pathConverter:#pathToPackage_win32:
+ ^ self
+ additionalHeaderRulesUsingTemplate:(self singleHeaderRuleTemplate_bc_dot_mak)
+ pathConverter:#pathToPackage_win32:
"Created: / 12-09-2011 / 15:44:09 / cg"
!
@@ -2082,9 +2082,9 @@
additionalHeaderRules_make_dot_proto
"rules for header files (of autoloaded classes)"
- ^ self
- additionalHeaderRulesUsingTemplate:(self singleHeaderRuleTemplate_make_dot_proto)
- pathConverter:#pathToPackage_unix:
+ ^ self
+ additionalHeaderRulesUsingTemplate:(self singleHeaderRuleTemplate_make_dot_proto)
+ pathConverter:#pathToPackage_unix:
"Created: / 12-09-2011 / 15:44:28 / cg"
!
@@ -3245,22 +3245,22 @@
d := Dictionary new.
d
- at: 'TAB' put: ( Character tab asString );
- at: 'TOP' put: ( self pathToTop_win32 );
- at: 'MODULE' put: ( self module );
- at: 'MODULE_DIRECTORY' put: ( self moduleDirectory );
- at: 'MODULE_PATH' put: ( self moduleDirectory_win32 );
- at: 'PRIMARY_TARGET' put: (self primaryTarget_bc_dot_mak);
- at: 'ADDITIONAL_BASE_ADDRESS_DEFINITION' put: (self additionalBaseAddressDefinition_bc_dot_mak ? '');
- at: 'ADDITIONAL_DEFINITIONS' put: (self additionalDefinitions_bc_dot_mak ? '');
- at: 'ADDITIONAL_HEADERRULES' put: (self additionalHeaderRules_bc_dot_mak);
- at: 'ADDITIONAL_RULES' put: (self additionalRules_bc_dot_mak ? '');
- at: 'ADDITIONAL_TARGETS' put: (self additionalTargets_bc_dot_mak ? '');
- at: 'ADDITIONAL_LINK_LIBRARIES' put: (self additionalLinkLibraries_bc_dot_mak ? '');
- at: 'LOCAL_INCLUDES' put: (self generateLocalIncludes_win32 ? '');
- at: 'LOCAL_DEFINES' put: self localDefines_win32 ? '';
- at: 'GLOBAL_DEFINES' put: self globalDefines_win32 ? '';
- at: 'MAKE_PREREQUISITES' put: (self generateRequiredMakePrerequisites_bc_dot_mak ? '').
+ at: 'TAB' put: ( Character tab asString );
+ at: 'TOP' put: ( self pathToTop_win32 );
+ at: 'MODULE' put: ( self module );
+ at: 'MODULE_DIRECTORY' put: ( self moduleDirectory );
+ at: 'MODULE_PATH' put: ( self moduleDirectory_win32 );
+ at: 'PRIMARY_TARGET' put: (self primaryTarget_bc_dot_mak);
+ at: 'ADDITIONAL_BASE_ADDRESS_DEFINITION' put: (self additionalBaseAddressDefinition_bc_dot_mak ? '');
+ at: 'ADDITIONAL_DEFINITIONS' put: (self additionalDefinitions_bc_dot_mak ? '');
+ at: 'ADDITIONAL_HEADERRULES' put: (self additionalHeaderRules_bc_dot_mak);
+ at: 'ADDITIONAL_RULES' put: (self additionalRules_bc_dot_mak ? '');
+ at: 'ADDITIONAL_TARGETS' put: (self additionalTargets_bc_dot_mak ? '');
+ at: 'ADDITIONAL_LINK_LIBRARIES' put: (self additionalLinkLibraries_bc_dot_mak ? '');
+ at: 'LOCAL_INCLUDES' put: (self generateLocalIncludes_win32 ? '');
+ at: 'LOCAL_DEFINES' put: self localDefines_win32 ? '';
+ at: 'GLOBAL_DEFINES' put: self globalDefines_win32 ? '';
+ at: 'MAKE_PREREQUISITES' put: (self generateRequiredMakePrerequisites_bc_dot_mak ? '').
^ d
"Created: / 18-08-2006 / 11:43:39 / cg"
@@ -3319,30 +3319,30 @@
make_dot_proto_mappings
^ Dictionary new
- at: 'TAB' put: ( Character tab asString );
- at: 'TOP' put: ( self pathToTop_unix );
- at: 'LIBRARY_NAME' put: ( self libraryName );
- at: 'SUBDIRECTORIES' put: (self generateSubDirectories);
- at: 'LOCAL_INCLUDES' put: (self generateLocalIncludes_unix);
- at: 'LOCAL_DEFINES' put: self localDefines_unix;
- at: 'GLOBAL_DEFINES' put: self globalDefines_unix;
- at: 'COMMONSYMFLAG' put: (self commonSymbolsFlag);
- at: 'HEADEROUTPUTARG' put: (self headerFileOutputArg);
- at: 'PRIMARY_TARGET' put: (self primaryTarget_make_dot_proto);
- at: 'ADDITIONAL_DEFINITIONS' put: (self additionalDefinitions_make_dot_proto);
- at: 'ADDITIONAL_HEADERRULES' put: (self additionalHeaderRules_make_dot_proto);
- at: 'ADDITIONAL_RULES' put: (self additionalRules_make_dot_proto);
- at: 'ADDITIONAL_RULES_SVN' put: (self additionalRulesSvn_make_dot_proto);
- at: 'ADDITIONAL_TARGETS' put: (self additionalTargets_make_dot_proto);
- at: 'ADDITIONAL_TARGETS_SVN' put: (self additionalTargetsSvn_make_dot_proto);
- at: 'ADDITIONAL_LINK_LIBRARIES' put: (self additionalLinkLibraries_make_dot_proto);
- at: 'ADDITIONAL_SHARED_LINK_LIBRARIES' put: (self additionalSharedLinkLibraries_make_dot_proto);
- at: 'DEPENDENCIES' put: (self generateDependencies_unix);
- at: 'MODULE' put: ( self module );
- at: 'MODULE_DIRECTORY' put: ( self moduleDirectory );
- at: 'MODULE_PATH' put: ( self moduleDirectory );
- at: 'MAKE_PREREQUISITES' put: (self generateRequiredMakePrerequisites_make_dot_proto);
- yourself
+ at: 'TAB' put: ( Character tab asString );
+ at: 'TOP' put: ( self pathToTop_unix );
+ at: 'LIBRARY_NAME' put: ( self libraryName );
+ at: 'SUBDIRECTORIES' put: (self generateSubDirectories);
+ at: 'LOCAL_INCLUDES' put: (self generateLocalIncludes_unix);
+ at: 'LOCAL_DEFINES' put: self localDefines_unix;
+ at: 'GLOBAL_DEFINES' put: self globalDefines_unix;
+ at: 'COMMONSYMFLAG' put: (self commonSymbolsFlag);
+ at: 'HEADEROUTPUTARG' put: (self headerFileOutputArg);
+ at: 'PRIMARY_TARGET' put: (self primaryTarget_make_dot_proto);
+ at: 'ADDITIONAL_DEFINITIONS' put: (self additionalDefinitions_make_dot_proto);
+ at: 'ADDITIONAL_HEADERRULES' put: (self additionalHeaderRules_make_dot_proto);
+ at: 'ADDITIONAL_RULES' put: (self additionalRules_make_dot_proto);
+ at: 'ADDITIONAL_RULES_SVN' put: (self additionalRulesSvn_make_dot_proto);
+ at: 'ADDITIONAL_TARGETS' put: (self additionalTargets_make_dot_proto);
+ at: 'ADDITIONAL_TARGETS_SVN' put: (self additionalTargetsSvn_make_dot_proto);
+ at: 'ADDITIONAL_LINK_LIBRARIES' put: (self additionalLinkLibraries_make_dot_proto);
+ at: 'ADDITIONAL_SHARED_LINK_LIBRARIES' put: (self additionalSharedLinkLibraries_make_dot_proto);
+ at: 'DEPENDENCIES' put: (self generateDependencies_unix);
+ at: 'MODULE' put: ( self module );
+ at: 'MODULE_DIRECTORY' put: ( self moduleDirectory );
+ at: 'MODULE_PATH' put: ( self moduleDirectory );
+ at: 'MAKE_PREREQUISITES' put: (self generateRequiredMakePrerequisites_make_dot_proto);
+ yourself
"Created: / 09-08-2006 / 11:20:45 / fm"
"Modified: / 09-08-2006 / 16:44:48 / fm"
@@ -3484,7 +3484,7 @@
classNamesByCategory
"answer a dictionary
- category -> classNames topological sorted"
+ category -> classNames topological sorted"
|pivateClassesOf sorter classes classNames mapping|
@@ -3495,57 +3495,57 @@
classes do:[:each | pivateClassesOf at:each put:(each allPrivateClasses)].
sorter := [:a :b |
- "/ a must come before b iff:
- "/ b is a subclass of a
- "/ b has a private class which is a subclass of a
- "/ a is a sharedPool, used by b
-
- |mustComeBefore pivateClassesOfB|
-
- mustComeBefore := false.
- mustComeBefore := (a isSharedPool and:[(b sharedPoolNames includes: a name)]).
- mustComeBefore := mustComeBefore or:[b isSubclassOf:a].
- mustComeBefore ifFalse:[
- pivateClassesOfB := pivateClassesOf at:b ifAbsent:[ #() ].
- pivateClassesOfB do:[:eachClassInB |
- mustComeBefore := mustComeBefore or:[eachClassInB isSubclassOf:a]
- ].
- ].
- mustComeBefore
+ "/ a must come before b iff:
+ "/ b is a subclass of a
+ "/ b has a private class which is a subclass of a
+ "/ a is a sharedPool, used by b
+
+ |mustComeBefore pivateClassesOfB|
+
+ mustComeBefore := false.
+ mustComeBefore := (a isSharedPool and:[(b sharedPoolNames includes: a name)]).
+ mustComeBefore := mustComeBefore or:[b isSubclassOf:a].
+ mustComeBefore ifFalse:[
+ pivateClassesOfB := pivateClassesOf at:b ifAbsent:[ #() ].
+ pivateClassesOfB do:[:eachClassInB |
+ mustComeBefore := mustComeBefore or:[eachClassInB isSubclassOf:a]
+ ].
+ ].
+ mustComeBefore
].
classes topologicalSort:sorter.
OperatingSystem knownPlatformNames do:[:platformID |
- |prefix depClasses depClassNames|
-
- prefix := platformID asUppercase.
- depClasses := self compiled_classesForArchitecture:platformID.
- depClasses notEmpty ifTrue:[
- (self compiled_classNamesForPlatform:platformID)
- select:[:nm | (Smalltalk at:nm ifAbsent:nil) isNil]
- thenDo:[:nm | Transcript showCR:nm].
- (depClasses includes:nil) ifTrue:[
- (Dialog confirm:'Dependencies might be incorrect (some classes are not present).\\Continue anyway ?' withCRs)
- ifFalse:[
- AbortOperationRequest raise.
- ].
- depClassNames := self compiled_classNamesForPlatform:platformID.
- ] ifFalse:[
- depClasses topologicalSort:sorter.
- depClassNames := depClasses collect:[:eachClass| eachClass name].
- ].
- mapping at:prefix put:depClassNames.
- ].
-
- classNames := classes collect:[:eachClass| eachClass name].
- self namesAndAttributesIn:(self additionalClassNamesAndAttributes) do: [:nm :attr |
- (attr isEmptyOrNil or:[(attr includes:#autoload) not]) ifTrue:[
- classNames add:nm.
- ].
- ].
-
- mapping at:'COMMON' put:classNames.
+ |prefix depClasses depClassNames|
+
+ prefix := platformID asUppercase.
+ depClasses := self compiled_classesForArchitecture:platformID.
+ depClasses notEmpty ifTrue:[
+ (self compiled_classNamesForPlatform:platformID)
+ select:[:nm | (Smalltalk at:nm ifAbsent:nil) isNil]
+ thenDo:[:nm | Transcript showCR:nm].
+ (depClasses includes:nil) ifTrue:[
+ (Dialog confirm:'Dependencies might be incorrect (some classes are not present).\\Continue anyway ?' withCRs)
+ ifFalse:[
+ AbortOperationRequest raise.
+ ].
+ depClassNames := self compiled_classNamesForPlatform:platformID.
+ ] ifFalse:[
+ depClasses topologicalSort:sorter.
+ depClassNames := depClasses collect:[:eachClass| eachClass name].
+ ].
+ mapping at:prefix put:depClassNames.
+ ].
+
+ classNames := classes collect:[:eachClass| eachClass name].
+ self namesAndAttributesIn:(self additionalClassNamesAndAttributes) do: [:nm :attr |
+ (attr isEmptyOrNil or:[(attr includes:#autoload) not]) ifTrue:[
+ classNames add:nm.
+ ].
+ ].
+
+ mapping at:'COMMON' put:classNames.
].
^ mapping
@@ -4483,14 +4483,14 @@
when being loaded themself."
self hasAllExtensionsLoaded ifFalse:[
- self breakPoint:#cg.
+ self breakPoint:#cg.
].
self hasAllClassesFullyLoaded ifFalse:[
- self hasAllClassesLoaded ifFalse:[
- self breakPoint:#cg.
- ].
- self installAutoloadedClasses.
- self classes do:[:cls | cls autoload ].
+ self hasAllClassesLoaded ifFalse:[
+ self breakPoint:#cg.
+ ].
+ self installAutoloadedClasses.
+ self classes do:[:cls | cls autoload ].
].
"
@@ -4523,26 +4523,26 @@
|newStuffHasBeenLoaded meOrMySecondIncarnation|
self projectIsLoaded ifTrue:[
- asAutoloaded ifFalse:[
- "/ to be considered !!
+ asAutoloaded ifFalse:[
+ "/ to be considered !!
"/ self isFullyLoaded ifFalse:[
"/ self hasAllExtensionsLoaded ifFalse:[
"/ self loadExtensions.
"/ ].
"/ self loadAllAutoloadedClasses
"/ ].
- ].
- ^ false
+ ].
+ ^ false
].
thisContext isRecursive ifTrue:[self breakPoint:#cg. ^ false]. "/ avoid endless loops
newStuffHasBeenLoaded := false.
(self infoPrinting and:[Smalltalk silentLoading not]) ifTrue:[
- "/ thisContext fullPrintAll.
- Transcript showCR:('loading %1%2...'
- bindWith:(asAutoloaded ifTrue:['as autoloaded '] ifFalse:[''])
- with:self name).
+ "/ thisContext fullPrintAll.
+ Transcript showCR:('loading %1%2...'
+ bindWith:(asAutoloaded ifTrue:['as autoloaded '] ifFalse:[''])
+ with:self name).
].
self rememberOverwrittenExtensionMethods.
@@ -4553,32 +4553,32 @@
meOrMySecondIncarnation := self.
Class withoutUpdatingChangesDo:[
- self activityNotification:'Loading prerequisities'.
- self loadPreRequisitesAsAutoloaded:asAutoloaded.
-
- self checkPrerequisitesForLoading.
-
- asAutoloaded ifFalse:[
- self loadClassLibrary.
- "/ could have overloaded my first incarnation
- meOrMySecondIncarnation := (Smalltalk at:(self name)) ? self.
- meOrMySecondIncarnation ~~ self ifTrue:[
- meOrMySecondIncarnation fetchSlotsFrom:self.
- ].
- ].
-
- self hasAllExtensionsLoaded ifFalse:[
- self activityNotification:'Loading extensions'.
- newStuffHasBeenLoaded := newStuffHasBeenLoaded | meOrMySecondIncarnation loadExtensions.
- ].
- self hasAllClassesLoaded ifFalse:[
- self activityNotification:'Loading classes'.
- newStuffHasBeenLoaded := newStuffHasBeenLoaded | (meOrMySecondIncarnation loadAllClassesAsAutoloaded:asAutoloaded).
- ].
+ self activityNotification:'Loading prerequisities'.
+ self loadPreRequisitesAsAutoloaded:asAutoloaded.
+
+ self checkPrerequisitesForLoading.
+
+ asAutoloaded ifFalse:[
+ self loadClassLibrary.
+ "/ could have overloaded my first incarnation
+ meOrMySecondIncarnation := (Smalltalk at:(self name)) ? self.
+ meOrMySecondIncarnation ~~ self ifTrue:[
+ meOrMySecondIncarnation fetchSlotsFrom:self.
+ ].
+ ].
+
+ self hasAllExtensionsLoaded ifFalse:[
+ self activityNotification:'Loading extensions'.
+ newStuffHasBeenLoaded := newStuffHasBeenLoaded | meOrMySecondIncarnation loadExtensions.
+ ].
+ self hasAllClassesLoaded ifFalse:[
+ self activityNotification:'Loading classes'.
+ newStuffHasBeenLoaded := newStuffHasBeenLoaded | (meOrMySecondIncarnation loadAllClassesAsAutoloaded:asAutoloaded).
+ ].
"/ no, don't load subProjects here - will lead to a recursion, which leads
"/ to some classes being loaded from source (soap)
- self activityNotification:'Loading sub projects'.
- meOrMySecondIncarnation loadSubProjectsAsAutoloaded:asAutoloaded.
+ self activityNotification:'Loading sub projects'.
+ meOrMySecondIncarnation loadSubProjectsAsAutoloaded:asAutoloaded.
].
self activityNotification:('Executing post-load action for %1' bindWith:self package).
@@ -4588,7 +4588,7 @@
meOrMySecondIncarnation projectIsLoaded:true.
meOrMySecondIncarnation ~~ self ifTrue:[
- self projectIsLoaded:true.
+ self projectIsLoaded:true.
].
self activityNotification:('Done (%1).' bindWith:self package).
@@ -4654,29 +4654,29 @@
|abbrevs|
AccessLock critical:[
- |mustRead file|
-
- AbbrevDictionary isNil ifTrue:[
- AbbrevDictionary := WeakIdentityDictionary new.
- ].
-
- mustRead := false.
- abbrevs := AbbrevDictionary at:self ifAbsent:[ mustRead := true. Dictionary new ].
-
- mustRead ifTrue:[
- file := self packageDirectory / 'abbrev.stc'.
- file exists ifTrue: [
- file readingFileDo:[:stream |
- Smalltalk
- withAbbreviationsFromStream:stream
- do:[:nm :fn :pkg :cat :sz|
- abbrevs at: nm put: (AbbrevEntry new className:nm fileName:fn category:cat numClassInstVars:sz)
- ]
- ]
- ].
- ].
+ |mustRead file|
+
+ AbbrevDictionary isNil ifTrue:[
+ AbbrevDictionary := WeakIdentityDictionary new.
+ ].
+
+ mustRead := false.
+ abbrevs := AbbrevDictionary at:self ifAbsent:[ mustRead := true. Dictionary new ].
+
+ mustRead ifTrue:[
+ file := self packageDirectory / 'abbrev.stc'.
+ file exists ifTrue: [
+ file readingFileDo:[:stream |
+ Smalltalk
+ withAbbreviationsFromStream:stream
+ do:[:nm :fn :pkg :cat :sz|
+ abbrevs at: nm put: (AbbrevEntry new className:nm fileName:fn category:cat numClassInstVars:sz)
+ ]
+ ]
+ ].
+ ].
].
-
+
^abbrevs
"Created: / 06-03-2011 / 18:25:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -5551,28 +5551,28 @@
"Handle smalltalk classes specially to provide backward compatibility"
lang isSmalltalk ifTrue:[
- entry := self abbrevs at: className ifAbsent:[nil].
-
- asAutoloaded ifTrue:[
- category := entry isNil ifTrue:[#autoloaded] ifFalse:[entry category].
- numClassInstVars := entry isNil ifTrue:[0] ifFalse:[entry numClassInstVars].
- cls := Smalltalk
- installAutoloadedClassNamed: className
- category: category
- package: self package
- revision: nil
- numClassInstVars:numClassInstVars.
- entry notNil ifTrue:[
- cls setClassFilename:(entry fileName,'.st').
- ].
- ^ cls.
- ].
- ^ Smalltalk
- fileInClass:className
- package:self package
- initialize:false
- lazy:false
- silent:true
+ entry := self abbrevs at: className ifAbsent:[nil].
+
+ asAutoloaded ifTrue:[
+ category := entry isNil ifTrue:[#autoloaded] ifFalse:[entry category].
+ numClassInstVars := entry isNil ifTrue:[0] ifFalse:[entry numClassInstVars].
+ cls := Smalltalk
+ installAutoloadedClassNamed: className
+ category: category
+ package: self package
+ revision: nil
+ numClassInstVars:numClassInstVars.
+ entry notNil ifTrue:[
+ cls setClassFilename:(entry fileName,'.st').
+ ].
+ ^ cls.
+ ].
+ ^ Smalltalk
+ fileInClass:className
+ package:self package
+ initialize:false
+ lazy:false
+ silent:true
].
"For non-smalltalk language do"
@@ -5961,42 +5961,42 @@
requiredClasses := (self searchForClassesWithProject: packageId) asSet.
withSubProjectsBoolean ifTrue:[
- "my subproject's classes are required"
- self subProjects do:[:eachProjectName |
- requiredClasses addAll: (self searchForClassesWithProject:eachProjectName asSymbol)
- ].
+ "my subproject's classes are required"
+ self subProjects do:[:eachProjectName |
+ requiredClasses addAll: (self searchForClassesWithProject:eachProjectName asSymbol)
+ ].
].
"all superclasses of my classes and my subProject's classes are required"
requiredClasses do:[:cls |
- cls allSuperclassesDo:[:eachSuperclass |
- (usedClassesWithReasons at: eachSuperclass ifAbsentPut:[OrderedSet new])
- add: (eachSuperclass name, ' - superclass of ', cls name).
- ]
+ cls allSuperclassesDo:[:eachSuperclass |
+ (usedClassesWithReasons at: eachSuperclass ifAbsentPut:[OrderedSet new])
+ add: (eachSuperclass name, ' - superclass of ', cls name).
+ ]
].
"all classes referenced by my classes or my subproject's classes
are required. But:
- only search for locals refered to by my methods (assuming that superclasses'
- prerequisites are specified in their package)."
+ only search for locals refered to by my methods (assuming that superclasses'
+ prerequisites are specified in their package)."
self addReferencesToClassesFromGlobalsIn:requiredClasses to:usedClassesWithReasons.
self addReferencesToClassesFromGlobalsInMethods:(self searchForExtensionsWithProject:self package) to:usedClassesWithReasons.
"all classes for which I define extensions are required"
self allExtensionClasses do:[:eachExtendedClass |
- (usedClassesWithReasons at:eachExtendedClass ifAbsentPut:[OrderedSet new])
- add: (eachExtendedClass name, ' - extended').
- eachExtendedClass allSuperclassesDo:[:eachSuperclass |
- (usedClassesWithReasons at: eachSuperclass ifAbsentPut:[OrderedSet new])
- add: (eachSuperclass name, ' - superclass of extended ', eachExtendedClass name).
- ]
+ (usedClassesWithReasons at:eachExtendedClass ifAbsentPut:[OrderedSet new])
+ add: (eachExtendedClass name, ' - extended').
+ eachExtendedClass allSuperclassesDo:[:eachSuperclass |
+ (usedClassesWithReasons at: eachSuperclass ifAbsentPut:[OrderedSet new])
+ add: (eachSuperclass name, ' - superclass of extended ', eachExtendedClass name).
+ ]
].
"don't put classes from subProjects into the required list"
ignoredPackages := (self siblingsAreSubProjects
- ifTrue:[ self searchForSiblingProjects ]
- ifFalse:[ self searchForSubProjects ]) asSet.
+ ifTrue:[ self searchForSiblingProjects ]
+ ifFalse:[ self searchForSubProjects ]) asSet.
ignoredPackages add:self package.
ignoredPackages add:PackageId noProjectID.
@@ -6004,11 +6004,11 @@
"now map classes to packages and collect the reasons"
requiredPackageReasons := Dictionary new.
usedClassesWithReasons keysAndValuesDo:[:usedClass :reasonsPerClass | |usedClassPackage|
- usedClassPackage := usedClass package.
- (ignoredPackages includes:usedClassPackage) ifFalse:[
- (requiredPackageReasons at:usedClassPackage ifAbsentPut:[OrderedSet new])
- addAll:reasonsPerClass.
- ].
+ usedClassPackage := usedClass package.
+ (ignoredPackages includes:usedClassPackage) ifFalse:[
+ (requiredPackageReasons at:usedClassPackage ifAbsentPut:[OrderedSet new])
+ addAll:reasonsPerClass.
+ ].
].
^ requiredPackageReasons
@@ -6174,26 +6174,26 @@
classes := IdentitySet new.
self extensionMethodNames pairWiseDo:[:className :selector |
- |mthdCls extendedClass|
-
- mthdCls := Smalltalk classNamed:className.
- (mthdCls notNil and:[mthdCls isLoaded]) ifTrue:[
- extendedClass := mthdCls theNonMetaclass.
- (classes includes:extendedClass) ifFalse:[
- withSuperclassesBoolean ifTrue:[
- extendedClass withAllSuperclassesDo:[:eachClass |
- classes add:eachClass.
- ].
- ] ifFalse:[
- classes add:extendedClass.
- ].
- ].
- ].
+ |mthdCls extendedClass|
+
+ mthdCls := Smalltalk classNamed:className.
+ (mthdCls notNil and:[mthdCls isLoaded]) ifTrue:[
+ extendedClass := mthdCls theNonMetaclass.
+ (classes includes:extendedClass) ifFalse:[
+ withSuperclassesBoolean ifTrue:[
+ extendedClass withAllSuperclassesDo:[:eachClass |
+ classes add:eachClass.
+ ].
+ ] ifFalse:[
+ classes add:extendedClass.
+ ].
+ ].
+ ].
].
^ classes.
"
- stx_libboss extensionClasses
+ stx_libboss extensionClasses
"
"Created: / 06-09-2011 / 10:17:06 / cg"
@@ -6221,7 +6221,7 @@
^ self allExtensionClasses collect:[:eachClass| eachClass package]
"
- stx_libboss extensionPackages
+ stx_libboss extensionPackages
"
"Modified: / 06-09-2011 / 10:20:47 / cg"
@@ -6394,33 +6394,33 @@
emptyProjects := Set withAll:self subProjects.
Smalltalk allClassesDo:[:cls |
- emptyProjects remove:(cls package) ifAbsent:[].
+ emptyProjects remove:(cls package) ifAbsent:[].
].
nonProjects := self subProjects select:[:p |
- (ProjectDefinition definitionClassForPackage: p) isNil
- ].
+ (ProjectDefinition definitionClassForPackage: p) isNil
+ ].
emptyOrNonProjects := Set withAll:emptyProjects.
emptyOrNonProjects addAll:nonProjects.
emptyOrNonProjects notEmpty ifTrue:[
- (Dialog
- confirm:('The following projects are non-existent, empty or without description:\\ '
- , ((emptyOrNonProjects
- asSortedCollection
- collect:[:p | p allBold])
- asStringWith:'\ ')
- , '\\Continue ?') withCRs
- yesLabel:'OK' noLabel:'Cancel')
- ifFalse:[
- AbortSignal raise
- ].
+ (Dialog
+ confirm:('The following projects are non-existent, empty or without description:\\ '
+ , ((emptyOrNonProjects
+ asSortedCollection
+ collect:[:p | p allBold])
+ asStringWith:'\ ')
+ , '\\Continue ?') withCRs
+ yesLabel:'OK' noLabel:'Cancel')
+ ifFalse:[
+ AbortSignal raise
+ ].
].
- classesInImage := Smalltalk allClasses select:[:cls | cls package = package].
+ classesInImage := Smalltalk allClasses select:[:cls | cls package = self package].
classesInDescription := self classes asIdentitySet.
classesInImage ~= classesInDescription ifTrue:[
- Dialog warn:'The set of classes in the image is different from the listed classes in the project definition'
+ Dialog warn:'The set of classes in the image is different from the listed classes in the project definition'
].
"
@@ -6477,7 +6477,7 @@
^ className
!
-className:classNameArg fileName:fileNameArg category:categoryArg numClassInstVars:numClassInstVarsArg
+className:classNameArg fileName:fileNameArg category:categoryArg numClassInstVars:numClassInstVarsArg
className := classNameArg.
fileName := fileNameArg.
category := categoryArg.
@@ -6499,11 +6499,11 @@
!ProjectDefinition class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.356 2011-09-14 13:39:47 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.357 2011-09-14 13:48:16 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.356 2011-09-14 13:39:47 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.357 2011-09-14 13:48:16 cg Exp $'
!
version_SVN