--- a/ApplicationDefinition.st Wed Mar 27 17:12:46 2013 +0000
+++ b/ApplicationDefinition.st Thu Mar 28 12:21:50 2013 +0000
@@ -159,7 +159,7 @@
super forEachMethodsCodeToCompileDo:aTwoArgBlock ignoreOldDefinition:ignoreOldDefinition.
#(
- (applicationIconFileName applicationIconFileName_code)
+ (applicationIconFileName applicationIconFileName_code 'description - project information')
(subProjects subProjects_code 'description')
(productInstallDirBaseName productInstallDirBaseName_code 'description - project information')
(startupClassName startupClassName_code 'description - startup')
@@ -408,77 +408,6 @@
"Modified: / 30-08-2006 / 19:29:25 / cg"
!
-applicationNameConsole
- ^ self applicationName, '.com'
-!
-
-applicationNameFromPackage
- "answer the name of the application.
- This is also the name of the generated .exe file.
-
- Subclasses may redefine this"
-
- |m path|
-
- m := self moduleDirectory.
- path := m subStrings:$/.
- path last = 'application' ifTrue:[
- path size > 1 ifTrue:[
- path := path copyWithoutLast:1.
- ].
- ].
- ^ path last
-
- "
- bosch_dapasx_application applicationName
- stx_projects_smalltalk applicationName
- alspa_batch_application applicationName
- "
-
- "Created: / 08-08-2006 / 20:25:39 / fm"
- "Modified: / 05-09-2012 / 10:08:44 / cg"
-!
-
-applicationNameNoConsole
- ^ self applicationName , '.exe'
-!
-
-applicationPackage
-
- ^self module, ':', self applicationNameFromPackage
-
- "
- bosch_dapasx_application applicationPackage
- stx_projects_smalltalk applicationPackage
- alspa_batch_application applicationPackage
- "
-
- "Created: / 08-08-2006 / 20:25:39 / fm"
- "Modified: / 30-08-2006 / 19:29:25 / cg"
-!
-
-applicationType
-
- ^self isGUIApplication
- ifTrue:['GUI_APPLICATION']
- ifFalse:['NON_GUI_APPLICATION']
-!
-
-commonFilesToInstall
- "files installed for applications.
- Do not redefine - see additionalFilesToInstall for a redefinable variant of this"
-
- ^ #(
- '"*.dll"'
- '"symbols.stc"'
- '"*.stx"'
- '"*.rc"'
- '/r /x CVS /x ".*" resources'
- )
-
- "Created: / 01-03-2007 / 20:05:40 / cg"
-!
-
documentExtensions
"list extensions which should be registered with the application.
Results in the application to be started when double-clicking on such a file (win32)"
@@ -572,7 +501,7 @@
makeConsoleApplication
"Used with WIN32 only (i.e. affects bc.mak).
Return true, if this should be built as a console application.
- Redefine to return true, if you want one always 8i.e. to generate both)."
+ Redefine to return true, if you want one always i.e. to generate both)."
^ self isConsoleApplication
!
@@ -625,8 +554,93 @@
"Modified: / 17-08-2006 / 20:01:00 / cg"
! !
+!ApplicationDefinition class methodsFor:'description - private'!
+
+applicationNameConsole
+ ^ self applicationName, '.com'
+!
+
+applicationNameFromPackage
+ "answer the name of the application.
+ This is also the name of the generated .exe file.
+
+ Subclasses may redefine this"
+
+ |m path|
+
+ m := self moduleDirectory.
+ path := m subStrings:$/.
+ path last = 'application' ifTrue:[
+ path size > 1 ifTrue:[
+ path := path copyWithoutLast:1.
+ ].
+ ].
+ ^ path last
+
+ "
+ bosch_dapasx_application applicationName
+ stx_projects_smalltalk applicationName
+ alspa_batch_application applicationName
+ "
+
+ "Created: / 08-08-2006 / 20:25:39 / fm"
+ "Modified: / 05-09-2012 / 10:08:44 / cg"
+!
+
+applicationNameNoConsole
+ ^ self applicationName , '.exe'
+!
+
+applicationPackage
+
+ ^self module, ':', self applicationNameFromPackage
+
+ "
+ bosch_dapasx_application applicationPackage
+ stx_projects_smalltalk applicationPackage
+ alspa_batch_application applicationPackage
+ "
+
+ "Created: / 08-08-2006 / 20:25:39 / fm"
+ "Modified: / 30-08-2006 / 19:29:25 / cg"
+!
+
+commonFilesToInstall
+ "files installed for applications - used only for NSIS installuer under WIN3.
+ Do not redefine - see additionalFilesToInstall for a redefinable variant of this"
+
+ ^ #(
+ '"*.dll"'
+ '"symbols.stc"'
+ '"*.stx"'
+ '"*.rc"'
+ '/r /x CVS /x ".*" resources'
+ )
+
+ "Created: / 01-03-2007 / 20:05:40 / cg"
+!
+
+docDirPath_unix
+ "path relative to my dir to the documentation - or nil"
+
+ ^ self docDirPath replaceAll:$\ with:$/.
+!
+
+docDirPath_win32
+ "path relative to my dir to the documentation - or nil"
+
+ ^ self docDirPath replaceAll:$/ with:$\.
+! !
+
!ApplicationDefinition class methodsFor:'description - project information'!
+applicationType
+
+ ^self isGUIApplication
+ ifTrue:['GUI_APPLICATION']
+ ifFalse:['NON_GUI_APPLICATION']
+!
+
description
"Returns a description string which will appear in nt.def / bc.def"
@@ -648,18 +662,6 @@
"Created: / 20-09-2006 / 17:58:40 / cg"
!
-docDirPath_unix
- "path relative to my dir to the documentation - or nil"
-
- ^ self docDirPath replaceAll:$\ with:$/.
-!
-
-docDirPath_win32
- "path relative to my dir to the documentation - or nil"
-
- ^ self docDirPath replaceAll:$/ with:$\.
-!
-
hasLicenceToAcceptDuringInstallation
^ false
@@ -2863,19 +2865,6 @@
!ApplicationDefinition class methodsFor:'queries'!
-canHaveExtensions
- "return true, if this class allows extensions from other packages.
- Private classes, namespaces and projectDefinitions dont allow this"
-
- ^ self == ApplicationDefinition
-
- "
- Smalltalk allClasses select:[:each | each canHaveExtensions not]
- "
-
- "Created: / 30-08-2006 / 15:29:49 / cg"
-!
-
projectType
^ self isGUIApplication
ifTrue:[ GUIApplicationType ]
@@ -2936,26 +2925,19 @@
!
isApplicationDefinition
- ^ self ~~ ApplicationDefinition
+ ^ self isAbstract not
"Created: / 23-08-2006 / 15:17:38 / cg"
-!
-
-isProjectDefinition
- ^ self ~~ ApplicationDefinition "/ skip myself - I am abstract
-
- "Created: / 17-08-2006 / 14:11:56 / cg"
- "Modified: / 08-02-2011 / 10:03:34 / cg"
! !
!ApplicationDefinition class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.228 2013-03-26 11:35:24 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.230 2013-03-27 12:18:03 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.228 2013-03-26 11:35:24 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.230 2013-03-27 12:18:03 stefan Exp $'
!
version_SVN
--- a/LibraryDefinition.st Wed Mar 27 17:12:46 2013 +0000
+++ b/LibraryDefinition.st Thu Mar 28 12:21:50 2013 +0000
@@ -663,19 +663,6 @@
!LibraryDefinition class methodsFor:'queries'!
-canHaveExtensions
- "return true, if this class allows extensions from other packages.
- Private classes, namespaces and projectDefinitions don't allow this"
-
- ^ self == LibraryDefinition
-
- "
- Smalltalk allClasses select:[:each | each canHaveExtensions not]
- "
-
- "Created: / 30-08-2006 / 15:29:53 / cg"
-!
-
projectType
^ LibraryType
! !
@@ -719,7 +706,7 @@
!
isLibraryDefinition
- ^ self ~~ LibraryDefinition
+ ^ self isAbstract not
"
stx_libboss isLibraryDefinition
@@ -728,28 +715,16 @@
"
"Created: / 23-08-2006 / 15:17:50 / cg"
-!
-
-isProjectDefinition
- ^ self ~~ LibraryDefinition "/ skip myself - I am abstract
-
- "
- stx_libboss isProjectDefinition
- ProjectDefinition isProjectDefinition
- "
-
- "Created: / 17-08-2006 / 14:11:46 / cg"
- "Modified: / 08-02-2011 / 10:03:42 / cg"
! !
!LibraryDefinition class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/LibraryDefinition.st,v 1.117 2013-03-25 12:16:02 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/LibraryDefinition.st,v 1.118 2013-03-27 12:18:12 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/LibraryDefinition.st,v 1.117 2013-03-25 12:16:02 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/LibraryDefinition.st,v 1.118 2013-03-27 12:18:12 stefan Exp $'
! !
--- a/ProjectDefinition.st Wed Mar 27 17:12:46 2013 +0000
+++ b/ProjectDefinition.st Thu Mar 28 12:21:50 2013 +0000
@@ -953,6 +953,22 @@
].
self classNamesAndAttributes:newSpec usingCompiler:compilerOrNil
+!
+
+updateExtensionMethodNamesUsingCompiler:compilerOrNil
+ "set the set of extension methods
+ Because this requires compilation of my extensionMethodNames-method,
+ a compiler can be passed in, which has to do the job.
+ (this is used by the systembrowser to pass in a CodeGeneratorTool with undo support)"
+
+ |newCode|
+
+ newCode := self extensionMethodNames_code.
+
+ (compilerOrNil ? self compilerClass)
+ compile:newCode
+ forClass:self theMetaclass
+ inCategory:'description - contents'.
! !
@@ -1458,6 +1474,10 @@
value: 'description'.
].
+ aTwoArgBlock
+ value: self subProjects_code
+ value: 'description'.
+
(self monticelloPackageName notNil and:[self respondsTo:#monticelloTimestamps_code]) ifTrue:[
aTwoArgBlock
value: self monticelloTimestamps_code
@@ -1658,6 +1678,27 @@
"Modified: / 09-10-2006 / 14:27:20 / cg"
!
+subProjects_code
+ "generate the code of the #subProjects method.
+ Returns nil if no such code is needed (because there are none)"
+
+ ^ String streamContents:[:s |
+ s nextPutLine:'subProjects'.
+ s nextPutLine:' "list packages which are known as subprojects.'.
+ s nextPutLine:' The generated makefile will enter those and make there as well.'.
+ s nextPutLine:' However: they are not forced to be loaded when a package is loaded;'.
+ s nextPutLine:' for those, redefine requiredPrerequisites"'.
+ s nextPutLine:''.
+ s nextPutLine:' ^ #('.
+ ProjectDefinition allSubclassesDo:[:each |
+ (each package startsWith:(self package,'/')) ifTrue:[
+ s nextPutLine:' #''',each package,''''.
+ ]
+ ].
+ s nextPutLine:' )'
+ ].
+!
+
svnRevisionNr_code: revisionNrOrNil
^ String streamContents:[:s |
s nextPutLine:'svnRevisionNr'.
@@ -1862,8 +1903,8 @@
subProjects
"list packages which are known as subprojects.
The generated makefile will enter those and make there as well.
- However: they are not forced to be loaded when a package is loaded; for those,
- redefine requiredPrerequisites."
+ However: they are not forced to be loaded when a package is loaded;
+ for those, redefine requiredPrerequisites."
^ #()
@@ -5489,7 +5530,7 @@
^ safeForOverwrittenMethods notEmptyOrNil
!
-methodOverwrittenBy:aMethod
+methodOverwrittenBy:anExtensionMethod
"return the (hidden) original method, which was located in another package
and which got overwritten by one of my extension methods. Nil if there is none."
@@ -5497,8 +5538,8 @@
extensionOverwriteInfo isNil ifTrue:[^ nil].
- mclass := aMethod mclass.
- selector := aMethod selector.
+ mclass := anExtensionMethod mclass.
+ selector := anExtensionMethod selector.
oldPackage := extensionOverwriteInfo at:(mclass name,'>>',selector) ifAbsent:nil.
oldPackage isNil ifTrue:[^ nil].
^ oldPackage asPackageId projectDefinitionClass
@@ -5564,12 +5605,13 @@
safeForOverwrittenMethods isNil ifTrue:[
safeForOverwrittenMethods := Dictionary new.
].
- safeForOverwrittenMethods at:(aClass name -> selector) put:oldMethod.
+ safeForOverwrittenMethods at:(aClass name,'>>',selector) put:oldMethod.
!
restoreOverwrittenExtensionMethods
"after unloading, tell other packages to restore any safed reference to any method
- which got overloaded by me."
+ which got overloaded by me.
+ Unfinished!!"
self extensionMethodNames pairWiseDo:[:className :selector |
|class oldMethod oldPackage|
@@ -5592,6 +5634,12 @@
safeForOverwrittenMethods isNil ifTrue:[^ nil].
^ safeForOverwrittenMethods at:(aClass name,'>>',aSelector) ifAbsent:nil
+!
+
+savedOverwrittenMethods
+ "return my saved original methods"
+
+ ^ safeForOverwrittenMethods ? #()
! !
!ProjectDefinition class methodsFor:'private-loading'!
@@ -6577,6 +6625,19 @@
"Created: / 30-08-2007 / 18:48:09 / cg"
!
+canHaveExtensions
+ "return true, if this class allows extensions from other packages.
+ Private classes, namespaces and projectDefinitions don't allow this"
+
+ ^ self isAbstract
+
+ "
+ Smalltalk allClasses select:[:each | each canHaveExtensions not]
+ "
+
+ "Created: / 30-08-2006 / 15:29:49 / cg"
+!
+
classNames
"answer an array containing all the class names of the project's classes"
@@ -6920,7 +6981,8 @@
validateDescription
"perform some consistency checks (set of classes in project same as those listed in description);
- called before checking in build support files"
+ called before checking in build support files.
+ Somewhat obsolete: use the ProjectChecker, which does more checks"
|emptyProjects nonProjects emptyOrNonProjects classesInImage
classesInDescription onlyInImage onlyInDescription missingPools myPackage|
@@ -6993,6 +7055,7 @@
].
].
].
+
missingPools notEmpty ifTrue:[
(Dialog
confirm:('The following sharedpools are non-existent, or not pools:\\ '
@@ -7007,6 +7070,7 @@
].
].
+"/ also found by ProjectChecker...
classesInImage ~= classesInDescription ifTrue:[
onlyInImage := (classesInImage reject:[:cls | classesInDescription includes:cls]).
onlyInImage notEmpty ifTrue:[
@@ -7020,6 +7084,7 @@
AbortSignal raiseRequest
]
].
+
"/ self validateOrderOfClasses
"
@@ -7104,7 +7169,7 @@
isProjectDefinition
"concrete i.e. not abstract"
- ^ self ~~ ProjectDefinition "/ skip myself - I am abstract
+ ^ self isAbstract not
"Created: / 10-08-2006 / 16:24:02 / cg"
"Modified: / 08-02-2011 / 10:03:49 / cg"
@@ -7142,11 +7207,11 @@
!ProjectDefinition class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.439 2013-03-26 13:21:07 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.444 2013-03-27 19:36:15 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.439 2013-03-26 13:21:07 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.444 2013-03-27 19:36:15 cg Exp $'
!
version_HG
--- a/Smalltalk.st Wed Mar 27 17:12:46 2013 +0000
+++ b/Smalltalk.st Thu Mar 28 12:21:50 2013 +0000
@@ -3191,6 +3191,14 @@
^ false
!
+includesIdentical:something
+ "this should come from Collection.
+ will change the inheritance - Smalltalk is actually a collection"
+
+ self do:[:element | element == something ifTrue:[^ true]].
+ ^ false
+!
+
isBrowserStartable
^ false.
@@ -7970,11 +7978,11 @@
!Smalltalk class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1017 2013-03-26 17:05:03 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1018 2013-03-27 19:13:42 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1017 2013-03-26 17:05:03 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1018 2013-03-27 19:13:42 cg Exp $'
!
version_HG
--- a/SmalltalkChunkFileSourceWriter.st Wed Mar 27 17:12:46 2013 +0000
+++ b/SmalltalkChunkFileSourceWriter.st Thu Mar 28 12:21:50 2013 +0000
@@ -12,7 +12,7 @@
"{ Package: 'stx:libbasic' }"
AbstractSourceFileWriter subclass:#SmalltalkChunkFileSourceWriter
- instanceVariableNames:'classBeingSaved methodsAlreadySaved'
+ instanceVariableNames:'classBeingSaved methodsAlreadySaved generatingSourceForOriginal'
classVariableNames:''
poolDictionaries:''
category:'Kernel-Classes'
@@ -110,6 +110,19 @@
"Created: / 21-08-2012 / 11:52:27 / cg"
! !
+!SmalltalkChunkFileSourceWriter methodsFor:'accessing'!
+
+generatingSourceForOriginal:aBoolean
+ "if false (the default), the source of the current (in image) code is generated.
+ That means, that any extension method which shadows some other original method,
+ that extension method's code is generated.
+ if true, the code of the original method is generated.
+ Use a true value, when generating code for a SCM checkin operation, as then we do not
+ want the extension to shadow the original"
+
+ generatingSourceForOriginal := aBoolean.
+! !
+
!SmalltalkChunkFileSourceWriter methodsFor:'source writing'!
fileOut:aClass on:outStreamArg withTimeStamp:stampIt withInitialize:initIt withDefinition:withDefinition methodFilter:methodFilter encoder:encoderOrNil
@@ -356,7 +369,7 @@
If both are nil, all are saved. See version-method handling in
fileOut for what this is needed."
- |sortedSelectors first prevPrivacy privacy interestingMethods cat|
+ |sortedSelectors first prevPrivacy privacy interestingMethods cat prjDef|
interestingMethods := OrderedCollection new.
aClass methodsDo:[:aMethod |
@@ -381,16 +394,36 @@
]
]
].
+
interestingMethods notEmpty ifTrue:[
- first := true.
- prevPrivacy := nil.
-
"/
"/ sort by selector
"/
sortedSelectors := interestingMethods collect:[:m | aClass selectorAtMethod:m].
sortedSelectors sortWith:interestingMethods.
+ generatingSourceForOriginal == true ifTrue:[
+ "/ care for methods which have been shadowed by an extension from another package!!
+ (prjDef := aClass theNonMetaclass projectDefinitionClass) notNil ifTrue:[
+ prjDef hasSavedOverwrittenMethods ifTrue:[
+ interestingMethods := interestingMethods collect:[:m |
+ |originalOrNil|
+
+ (m package ~~ aClass package) ifTrue:[
+ originalOrNil := prjDef savedOverwrittenMethods at:(aClass name -> m selector) ifAbsent:nil.
+ originalOrNil notNil ifTrue:[
+ self breakPoint:#cg
+ ].
+ ].
+ originalOrNil ? m
+ ].
+ ]
+ ].
+ ].
+
+ first := true.
+ prevPrivacy := nil.
+
interestingMethods do:[:eachMethod |
privacy := eachMethod privacy.
@@ -580,8 +613,12 @@
!SmalltalkChunkFileSourceWriter class methodsFor:'documentation'!
+version
+ ^ '$Header: /cvs/stx/stx/libbasic/SmalltalkChunkFileSourceWriter.st,v 1.21 2013-03-27 16:50:00 cg Exp $'
+!
+
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/SmalltalkChunkFileSourceWriter.st,v 1.19 2012-12-17 12:48:08 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SmalltalkChunkFileSourceWriter.st,v 1.21 2013-03-27 16:50:00 cg Exp $'
!
version_SVN
--- a/StandaloneStartup.st Wed Mar 27 17:12:46 2013 +0000
+++ b/StandaloneStartup.st Thu Mar 28 12:21:50 2013 +0000
@@ -1130,6 +1130,9 @@
"/ |app fileArg|
"/
"/ self verboseInfo:('starting application').
+"/
+"/ self startStartBlockProcess.
+"/ Smalltalk openDisplay.
"/ app := <someGUIApplicationModelClass> open.
"/
"/ self verboseInfo:('looking for args in ',argv).
@@ -1158,11 +1161,12 @@
!StandaloneStartup class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/StandaloneStartup.st,v 1.70 2012-12-05 15:38:04 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/StandaloneStartup.st,v 1.71 2013-03-27 10:49:17 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/StandaloneStartup.st,v 1.70 2012-12-05 15:38:04 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/StandaloneStartup.st,v 1.71 2013-03-27 10:49:17 stefan Exp $'
! !
+
StandaloneStartup initialize!
--- a/Win32Process.st Wed Mar 27 17:12:46 2013 +0000
+++ b/Win32Process.st Thu Mar 28 12:21:50 2013 +0000
@@ -198,13 +198,16 @@
action:[:status |
status stillAlive ifFalse:[
exitStatus := status.
+ "/ paranoia?
+ OperatingSystem terminateProcessGroup:pid.
+ OperatingSystem terminateProcess:pid.
OperatingSystem closePid:pid.
finishSema signal
].
].
pid isNil ifTrue:[
- exitStatus := self osProcessStatusClass processCreationFailure.
+ exitStatus := OperatingSystem osProcessStatusClass processCreationFailure.
^ false
].
@@ -217,9 +220,10 @@
!Win32Process class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Win32Process.st,v 1.2 2010-02-01 11:29:35 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Win32Process.st,v 1.3 2013-03-27 18:19:55 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Win32Process.st,v 1.2 2010-02-01 11:29:35 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Win32Process.st,v 1.3 2013-03-27 18:19:55 cg Exp $'
! !
+