--- a/ProjectDefinition.st Wed Aug 19 20:09:37 2009 +0200
+++ b/ProjectDefinition.st Wed Aug 19 20:16:45 2009 +0200
@@ -2108,34 +2108,49 @@
"Modified: / 14-09-2006 / 21:07:49 / cg"
!
+generateRemoveShellScriptOn:aStream
+ "generate a shell script to a cvs remove of broken class filenames.
+ To be called after the output of #generateRenameShellScript: has been performed"
+
+ |firstLine|
+
+ firstLine := true.
+ self searchForClasses do:[:eachClass|
+ firstLine ifTrue:[
+ aStream nextPutAll:'cvs rm -f '.
+ firstLine := false.
+ ].
+ eachClass classFilename ~= (eachClass generateClassFilename, '.st') ifTrue:[
+ aStream nextPutAll:eachClass classBaseFilename; space.
+ ]
+ ].
+ firstLine ifFalse:[
+ aStream cr.
+ ].
+
+ "
+ stx_goodies_webServer_htmlTree generateRemoveShellScriptOn:Transcript
+ "
+!
+
+generateRenameShellScriptOn:aStream
+ "generate a shell script to rename broken class filenames"
+
+ self searchForClasses do:[:eachClass|
+ eachClass classFilename ~= (eachClass generateClassFilename, '.st') ifTrue:[
+ aStream nextPutAll:'cp ';
+ nextPutAll:eachClass classBaseFilename; nextPutAll:',v ';
+ nextPutAll:eachClass generateClassFilename; nextPutAll:',v'; cr.
+ ]
+ ].
+
+ "
+ stx_goodies_webServer_htmlTree generateRenameShellScriptOn:Transcript
+ "
+!
+
generate_abbrev_dot_stc
- |someNilClassesName check|
-
- check :=
- [:eachClassName |
- |cls fn wasLoaded failedToLoad numClassInstvars|
-
- cls := Smalltalk classNamed:eachClassName.
- cls isNil ifTrue:[
- Transcript showCR:eachClassName.
- someNilClassesName := eachClassName.
- ].
- ].
-
- self allClassNames do:check.
- self namesAndAttributesIn:(self additionalClassNamesAndAttributes) do: [:nm :attr |
- (attr isEmptyOrNil or:[(attr includes:#autoload) not]) ifTrue:[
- check value:nm
- ].
- ].
- someNilClassesName notNil ifTrue:[
- (Dialog confirm:(Dialog classResources
- stringWithCRs:'"%1" and possibly more classes are missing.\Cannot generate a correct "abbrev.stc" file.\\Continue anyway?'
- with:someNilClassesName allBold))
- ifFalse:[
- AbortSignal raise.
- ].
- ].
+ self checkIfClassesArePresent.
^ String
streamContents:[:s |
@@ -2150,11 +2165,7 @@
cls := Smalltalk classNamed:eachClassName.
cls isNil ifTrue:[
- fn := (self filenameForClassNamed:eachClassName) asFilename withoutSuffix.
- fn suffix notEmptyOrNil ifTrue:[
- fn := fn withoutSuffix
- ].
- fn := fn baseName.
+ fn := self filenameForClass:eachClassName.
s nextPutAll:fn.
s nextPutAll:' '; nextPutAll:(self package); nextPutAll:' '.
s nextPutAll:' '; nextPutAll:'unknownCategory' storeString; nextPutAll:' '.
@@ -2175,11 +2186,7 @@
].
].
- fn := cls classFilename asFilename withoutSuffix.
- fn suffix notEmptyOrNil ifTrue:[
- fn := fn withoutSuffix
- ].
- fn := fn baseName.
+ fn := self filenameForClass:cls.
(fn includes:Character space) ifTrue:[
s nextPutAll:fn storeString.
] ifFalse:[
@@ -2282,15 +2289,15 @@
'.
classesSorted do:[:eachClass |
- s nextPutLine:' ''' , eachClass classBaseFilename, ''''.
+ s nextPutLine:' ''' , (self filenameForClass:eachClass), ''''.
].
classNamesUnloaded do:[:nm |
- s nextPutLine:' ''' , (self filenameForClassNamed:nm) asFilename baseName, ''''.
+ s nextPutLine:' ''' , (self filenameForClass:nm), ''''.
].
self namesAndAttributesIn:(self additionalClassNamesAndAttributes) do:[:nm :attr |
(attr isEmptyOrNil or:[(attr includes:#autoload) not]) ifTrue:[
- s nextPutLine:' ''' , (self filenameForClassNamed:nm) asFilename baseName, ''''.
+ s nextPutLine:' ''' , (self filenameForClass:nm), ''''.
].
].
@@ -2665,23 +2672,6 @@
"Created: / 19-09-2006 / 22:47:43 / cg"
!
-filenameForClassNamed:className
- |class|
-
- class := Smalltalk classNamed:className.
- class notNil ifTrue:[
- "/ the actual name
- ^ class classFilename asFilename withoutSuffix baseName
- ] ifFalse:[
- "/ the expected name
- ^ Smalltalk fileNameForClass:className
- ].
-
- "Created: / 08-08-2006 / 20:17:28 / fm"
- "Modified: / 09-08-2006 / 18:26:52 / fm"
- "Modified: / 20-10-2006 / 16:22:58 / cg"
-!
-
make_dot_proto_mappings
^ Dictionary new
at: 'TAB' put: ( Character tab asString );
@@ -2725,16 +2715,6 @@
"Modified: / 14-09-2006 / 18:51:24 / cg"
!
-objectLine_make_dot_spec_mappings: aClassName
- ^ Dictionary new
- at: 'CLASSFILE' put:(self filenameForClassNamed:aClassName);
- yourself
-
- "Created: / 08-08-2006 / 20:17:28 / fm"
- "Modified: / 09-08-2006 / 18:26:52 / fm"
- "Modified: / 20-10-2006 / 16:22:58 / cg"
-!
-
packageName_dot_rc_mappings
|d s resourceCount|
@@ -2812,6 +2792,34 @@
^ ''
!
+filenameForClass:classNameOrClass
+ "answer the base filename of the class without suffix"
+
+"/ "enable this code if you want to convert old filenames to new filenames.
+"/ See also: #generateRemoveShellScriptOn: and #generateRenamShellScriptOn:"
+"/ classNameOrClass isBehavior ifTrue:[
+"/ ^ classNameOrClass generateClassFilename.
+"/ ] ifFalse:[
+"/ |cls|
+"/
+"/ cls := Smalltalk classNamed:classNameOrClass.
+"/ cls notNil ifTrue:[
+"/ ^ cls generateClassFilename.
+"/ ].
+"/ ].
+"/ "end special code"
+
+ ^ Smalltalk fileNameForClass:classNameOrClass.
+
+ "
+ self filenameForClass:HTML::Encoder
+ Smalltalk fileNameForClass:HTML::Encoder
+ "
+
+ "Created: / 08-08-2006 / 20:17:28 / fm"
+ "Modified: / 20-10-2006 / 16:22:58 / cg"
+!
+
generateClassLines:classLineTemplate
^ String
streamContents:[:s |
@@ -2899,7 +2907,7 @@
s nextPutAll:' $(INCLUDE_TOP)'.
s nextPutAll:(self pathSeparator:whichArchitecture) asString.
- sclsBaseName := cls classFilename asFilename withoutSuffix baseName.
+ sclsBaseName := self filenameForClass:cls.
s nextPutAll:(self
topRelativePathTo:sclsBaseName
inPackage:cls package
@@ -2908,7 +2916,6 @@
].
putDependencyForClassBaseNameBlock := [:clsBaseName |
-
s nextPutAll:'$(OUTDIR)'.
s nextPutAll:clsBaseName.
s nextPutAll:'.$(O)'.
@@ -2924,7 +2931,7 @@
putDependencyForClassBlock := [:cls |
|clsBaseName already|
- clsBaseName := cls classFilename asFilename withoutSuffix baseName.
+ clsBaseName := self filenameForClass:cls.
putDependencyForClassBaseNameBlock value:clsBaseName.
cls isLoaded ifTrue:[
already := IdentitySet new.
@@ -2958,12 +2965,11 @@
s nextPutAll:'$(OUTDIR)extensions.$(O): extensions.st'.
already := Set new.
- self extensionMethodNames
- pairWiseDo:[:className :selector |
+ self extensionMethodNames pairWiseDo:[:className :selector |
|mthdCls cls|
((mthdCls := Smalltalk classNamed:className) notNil
- and:[ mthdCls isLoaded ])
+ and:[ mthdCls isLoaded ])
ifTrue:[
cls := mthdCls theNonMetaclass.
(already includes:cls) ifFalse:[
@@ -2982,13 +2988,15 @@
classNames := self compiled_classNames_common.
classesPresent := classNames
- collect:[:className | Smalltalk classNamed:className]
- thenSelect:[:cls | cls notNil].
+ collect:[:className | Smalltalk classNamed:className]
+ thenSelect:[:cls | cls notNil].
classesLoaded := classesPresent
- select:[:cls | cls isLoaded].
-
- (Class classesSortedByLoadOrder:classesLoaded) do:putDependencyForClassBlock.
- (classesPresent select:[:cls | cls isLoaded not]) do:putDependencyForClassBlock.
+ select:[:cls | cls isLoaded].
+
+ (Class classesSortedByLoadOrder:classesLoaded)
+ do:putDependencyForClassBlock.
+ (classesPresent select:[:cls | cls isLoaded not])
+ do:putDependencyForClassBlock.
self namesAndAttributesIn:(self additionalClassNamesAndAttributes)
do:[:className :attr |
@@ -3008,7 +3016,8 @@
archClassesLoaded := archClassesPresent
select:[:cls | cls isLoaded].
- (Class classesSortedByLoadOrder:archClassesLoaded) do:putDependencyForClassBlock.
+ (Class classesSortedByLoadOrder:archClassesLoaded)
+ do:putDependencyForClassBlock.
"some classes are not loaded - probably this is the wrong architecture.
Sorry, but for these classes, we do not know the superclass chain"
@@ -3021,7 +3030,7 @@
archClassNames
select:[:eachClassName | (Smalltalk classNamed:eachClassName) isNil]
thenDo:[:eachClassName |
- putDependencyForClassBaseNameBlock value:(eachClassName copyReplaceAll:$: with:$_).
+ putDependencyForClassBaseNameBlock value:(self filenameForClass:eachClassName).
s nextPutLine:' $(STCHDR)'.
].
@@ -3176,7 +3185,7 @@
self namesAndAttributesIn:(self additionalClassNamesAndAttributes) do: [:nm :attr |
(attr isEmptyOrNil or:[(attr includes:#autoload) not]) ifTrue:[
- s nextPutLine:(' $(OUTDIR)',(self filenameForClassNamed:nm),'.$(O) \').
+ s nextPutLine:(' $(OUTDIR)' , (self filenameForClass:nm) , '.$(O) \').
].
].
@@ -3277,6 +3286,16 @@
"Modified: / 14-09-2006 / 15:38:25 / cg"
!
+objectLine_make_dot_spec_mappings: aClassName
+ ^ Dictionary new
+ at: 'CLASSFILE' put:(self filenameForClass:aClassName);
+ yourself
+
+ "Created: / 08-08-2006 / 20:17:28 / fm"
+ "Modified: / 09-08-2006 / 18:26:52 / fm"
+ "Modified: / 20-10-2006 / 16:22:58 / cg"
+!
+
subProjectBmakeCalls
^ String streamContents:[:s |
self subProjects do:[:packageID |
@@ -3293,6 +3312,45 @@
!ProjectDefinition class methodsFor:'private'!
+checkIfClassesArePresent
+ "check if all classes defined by this project are present and
+ offer a dialog to abort the current operation if not"
+
+ |check nonExistantClasses|
+
+ nonExistantClasses := Set new.
+
+ check :=
+ [:eachClassName |
+ |cls fn wasLoaded failedToLoad numClassInstvars|
+
+ cls := Smalltalk classNamed:eachClassName.
+ cls isNil ifTrue:[
+ Transcript showCR:eachClassName.
+ nonExistantClasses add:eachClassName.
+ ].
+ ].
+
+ self allClassNames do:check.
+ self namesAndAttributesIn:(self additionalClassNamesAndAttributes) do:[:nm :attr |
+ (attr isEmptyOrNil or:[(attr includes:#autoload) not]) ifTrue:[
+ check value:nm
+ ].
+ ].
+
+ nonExistantClasses notEmpty ifTrue:[
+ (Dialog confirm:(Dialog classResources
+ stringWithCRs:'"%1" and possibly more classes are missing.\Cannot generate a correct "abbrev.stc" file.\\Continue anyway?'
+ with:nonExistantClasses anElement allBold))
+ ifFalse:[
+ AbortOperationRequest raise.
+ ].
+ ^ false.
+ ].
+
+ ^ true
+!
+
classNamesAndAttributesDo: aBlock
self namesAndAttributesIn:(self classNamesAndAttributes) do: aBlock
@@ -3453,6 +3511,7 @@
"
stx_libbasic3 searchForClasses
+ stx_goodies_webServer_htmlTree searchForClasses
"
"Modified: / 07-08-2006 / 21:56:25 / fm"
@@ -4192,7 +4251,7 @@
!ProjectDefinition class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.223 2009-08-03 12:24:18 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.224 2009-08-19 18:16:45 stefan Exp $'
! !
ProjectDefinition initialize!