--- a/Behavior.st Thu Aug 18 10:37:43 2011 +0100
+++ b/Behavior.st Sat Aug 20 21:29:33 2011 +0100
@@ -1013,6 +1013,8 @@
"Modified: 23.4.1996 / 15:55:52 / cg"
! !
+
+
!Behavior methodsFor:'Compatibility-Dolphin'!
allSubinstances
@@ -1054,6 +1056,16 @@
self comment:comment
!
+classSide
+ "alias for theMetaclass - return the metaclass"
+
+ ^ self theMetaclass
+
+ "Created: / 26-08-2009 / 11:44:51 / Jaroslav Havlin <havlij6@fel.cvut.cz>"
+ "Modified: / 12-09-2010 / 16:38:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 20-08-2011 / 16:33:47 / cg"
+!
+
defaultNameStemForInstances
"Answer a basis for names of default instances of the receiver"
@@ -1079,6 +1091,15 @@
SmallInteger selectorsWithArgs:3
SmallInteger selectorsWithArgs:4
"
+!
+
+theNonMetaClass
+ "alias for theNonMetaclass - return the class"
+
+ ^ self theNonMetaclass
+
+ "Created: / 26-08-2009 / 11:39:08 / Jaroslav Havlin <havlij6@fel.cvut.cz>"
+ "Modified (comment): / 20-08-2011 / 16:35:07 / cg"
! !
!Behavior methodsFor:'Compatibility-VW'!
@@ -1591,7 +1612,6 @@
^ self
! !
-
!Behavior methodsFor:'dummy changes management'!
addChangeRecordForClassRemove:aClassName
@@ -4720,11 +4740,11 @@
!Behavior class methodsFor:'documentation'!
-
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.313 2011/06/28 19:32:32 cg Exp §'
+ ^ 'Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.314 2011/08/20 14:36:35 cg Exp '
!
version_SVN
- ^ '$Id: Behavior.st 10660 2011-07-18 15:22:09Z vranyj1 $'
+ ^ '$ Id: Behavior.st 10643 2011-06-08 21:53:07Z vranyj1 $'
! !
+
--- a/ClassBuilder.st Thu Aug 18 10:37:43 2011 +0100
+++ b/ClassBuilder.st Sat Aug 20 21:29:33 2011 +0100
@@ -20,7 +20,8 @@
nameKey newSuperClass superClassChange newClassVars newInstVars
classVarChange instVarChange recompileGlobalAccessTo
oldClassToBecomeNew oldClassInstVars newClassInstVars'
- classVariableNames:''
+ classVariableNames:'LastNamespace LastNamespaceName LastClassesInNameSpace
+ LastClassNamesInNameSpace'
poolDictionaries:''
category:'Kernel-Support'
!
@@ -41,6 +42,41 @@
"
! !
+!ClassBuilder class methodsFor:'change & update'!
+
+initialize
+ Smalltalk addDependent:self.
+
+ "Created: / 18-08-2011 / 14:32:27 / cg"
+!
+
+update:something with:aParameter from:changedObject
+ "keep track of the namespace->classnames cache"
+
+ something == #projectOrganization ifTrue:[^ self].
+ something == #classVariables ifTrue:[^ self].
+ something == #methodInClass ifTrue:[^ self].
+
+ something == #newClass ifTrue:[
+ aParameter nameSpace name = LastNamespaceName ifTrue:[
+ LastClassNamesInNameSpace add:aParameter name
+ ].
+ ^ self.
+ ].
+ something == #classRemove ifTrue:[
+ aParameter nameSpace name = LastNamespaceName ifTrue:[
+ LastClassNamesInNameSpace remove:aParameter name
+ ].
+ ^ self.
+ ].
+
+ "/ Transcript show:something.
+ "/ Transcript show:' -> '.
+ "/ Transcript showCR:aParameter.
+
+ "Created: / 18-08-2011 / 14:32:16 / cg"
+! !
+
!ClassBuilder class methodsFor:'checks'!
checkForAliasesOf:oldClass with:newClass
@@ -237,29 +273,45 @@
recompileGlobalAccessorsTo:aGlobalKey in:aNamespace except:someClass
"when a new class enters a namespace, all accessors to the same-named
- class in that namespace must be recompiled"
+ class in that namespace must be recompiled.
+ Because that is used heavily during package loading (for the same namespace), cache it."
+
+ |privateClassNames|
- aNamespace allPrivateClassesDo:[:aClass |
- aClass ~~ someClass ifTrue:[
- aClass isLoaded ifTrue:[
+ aNamespace name = LastNamespaceName ifTrue:[
+ privateClassNames := LastClassNamesInNameSpace
+ ] ifFalse:[
+ privateClassNames := LastClassNamesInNameSpace := aNamespace allPrivateClasses
+ reject:[:cls | cls isJavaClass or:[cls isNameSpace] ]
+ thenCollect:[:each | each name].
+ LastNamespaceName := aNamespace name.
+ ].
+
+ privateClassNames do:[:eachClassName |
+ |cls|
+
+ cls := Smalltalk classNamed:eachClassName.
+ (cls notNil and:[cls ~~ someClass]) ifTrue:[
+ cls isLoaded ifTrue:[
"/ Smalltalk silentLoading ifFalse:[
"/ Transcript showCR:'recompiling methods in ''' , aClass name , ''' accessing ''' , aGlobalKey , ''''.
"/ Transcript endEntry.
"/ ].
- aClass recompileMethodsAccessingGlobal:aGlobalKey.
- aClass class recompileMethodsAccessingGlobal:aGlobalKey.
+ cls recompileMethodsAccessingGlobal:aGlobalKey.
+ cls class recompileMethodsAccessingGlobal:aGlobalKey.
"/ actually - must eventually recompile USERS of this namespace too
]
]
].
+
aNamespace isNameSpace ifFalse:[
aNamespace recompileMethodsAccessingGlobal:aGlobalKey.
aNamespace class recompileMethodsAccessingGlobal:aGlobalKey.
].
- "Modified: 31.1.1997 / 11:22:57 / cg"
+ "Modified: / 19-08-2011 / 01:00:49 / cg"
!
recompileMachineCodeMethodsIn:aClass
@@ -411,7 +463,7 @@
oldClass notNil ifTrue:[
(oldClass isRealNameSpace) ifTrue:[
- (superClass == NameSpace or:[superClass isNamespace]) ifFalse:[
+ (superClass == NameSpace or:[superClass isNameSpace]) ifFalse:[
ClassBuildError raiseErrorString:'class exists as namespace'.
^ nil.
].
@@ -599,7 +651,7 @@
"Created: / 26-05-1996 / 11:55:26 / cg"
"Modified: / 18-03-1999 / 18:23:31 / stefan"
- "Modified: / 18-01-2011 / 17:56:34 / cg"
+ "Modified: / 19-08-2011 / 01:00:46 / cg"
!
newSubclassOf:baseClass type:typeOfClass instanceVariables:instanceVariables from:oldClassArg
@@ -1679,7 +1731,7 @@
newSub classAttributes:t.
].
newSub package:(aSubclass package).
- newSub setClassFilename:(oldClass classFilename).
+ newSub setClassFilename:(aSubclass classFilename).
newSub setComment:(aSubclass comment).
newSub setCategory:(aSubclass category).
newSub instSize:(aSubclass instSize).
@@ -1824,7 +1876,7 @@
"Created: / 29-10-1995 / 19:57:08 / cg"
"Modified: / 01-04-1997 / 15:44:09 / stefan"
- "Modified: / 18-01-2011 / 20:44:41 / cg"
+ "Modified: / 20-08-2011 / 17:42:53 / cg"
!
setPackageInNewClass:newClass fromOld:oldClass
@@ -1837,6 +1889,7 @@
"/ new classes get the current package ...
pkg := Class packageQuerySignal query.
] ifFalse:[
+ "/ cg: is this correct ?
newClass setClassFilename:(oldClass getClassFilename).
oldPkg := oldClass package.
@@ -1877,7 +1930,7 @@
newClass package:pkg.
].
- "Modified: / 06-10-2006 / 13:17:07 / cg"
+ "Modified (format): / 20-08-2011 / 17:44:15 / cg"
!
setupNewClass:newClass fromOld:oldClass
@@ -2226,12 +2279,15 @@
"Modified: 9.1.1997 / 02:10:02 / cg"
! !
+
!ClassBuilder class methodsFor:'documentation'!
version
- ^ '$Id: ClassBuilder.st 10660 2011-07-18 15:22:09Z vranyj1 $'
+ ^ '$Id: ClassBuilder.st 10672 2011-08-20 20:29:33Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/ClassBuilder.st,v 1.99 2011/01/30 09:59:26 cg Exp §'
+ ^ 'Header: /cvs/stx/stx/libbasic/ClassBuilder.st,v 1.103 2011/08/20 15:44:43 cg Exp '
! !
+
+ClassBuilder initialize!
--- a/ClassDescription.st Thu Aug 18 10:37:43 2011 +0100
+++ b/ClassDescription.st Sat Aug 20 21:29:33 2011 +0100
@@ -654,6 +654,7 @@
"Modified: 23.4.1996 / 15:56:54 / cg"
! !
+
!ClassDescription methodsFor:'Compatibility-Dolphin'!
categoriesFor:aMethodSelector
@@ -4105,13 +4106,14 @@
!ClassDescription class methodsFor:'documentation'!
version
- ^ '$Id: ClassDescription.st 10660 2011-07-18 15:22:09Z vranyj1 $'
+ ^ '$Id: ClassDescription.st 10672 2011-08-20 20:29:33Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.215 2011/01/18 17:07:42 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.217 2011/08/20 14:36:03 cg Exp §'
! !
ClassDescription initialize!
ClassDescription::MethodRedefinitionNotification initialize!
ClassDescription::ClassRedefinitionNotification initialize!
+
--- a/ProjectDefinition.st Thu Aug 18 10:37:43 2011 +0100
+++ b/ProjectDefinition.st Sat Aug 20 21:29:33 2011 +0100
@@ -14,7 +14,7 @@
Object subclass:#ProjectDefinition
instanceVariableNames:''
classVariableNames:'LibraryType GUIApplicationType NonGUIApplicationType
- PackagesBeingLoaded Verbose AbbrevDictionary'
+ PackagesBeingLoaded Verbose AbbrevDictionary AccessLock'
poolDictionaries:''
category:'System-Support-Projects'
!
@@ -26,6 +26,13 @@
"
!
+Object subclass:#AbbrevEntry
+ instanceVariableNames:'className fileName category numClassInstVars'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:ProjectDefinition
+!
+
!ProjectDefinition class methodsFor:'documentation'!
buildingMakefiles
@@ -1131,12 +1138,13 @@
LibraryType := #'Library'.
GUIApplicationType := #'GUI-Application'.
NonGUIApplicationType := #'NonGUI-Application'.
+ AccessLock := Semaphore forMutualExclusion.
"
self initialize
"
- "Modified: / 23-10-2006 / 16:40:58 / cg"
+ "Modified: / 18-08-2011 / 13:48:31 / cg"
!
initializeAllProjectDefinitions
@@ -1165,47 +1173,66 @@
installAutoloadedClasses
"install all of my autoloaded classes (if any)"
- (self classNamesForWhich:[:nm :attr | (attr includes:#autoload)])
- do:[:className |
- "/ 'install as autoloaded: ' errorPrint. className errorPrintCR.
- (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:[
- Smalltalk
- installAutoloadedClassNamed:className
- category:'* as yet unknown category *'
- package:self package
- revision:nil
- ].
- ].
- ].
+ self autoloaded_classNames do:[:className |
+ |cls classFilenameFromAbbreviations entry|
+
+ "/ '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:[
+ entry := self 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
+ ].
+ ].
+ ]
+ ].
+ ].
+ ].
Smalltalk isStandAloneApp ifFalse:[
- Smalltalk addStartBlock:[
- |abbrevs|
-
- Class withoutUpdatingChangesDo:[
- abbrevs := self abbrevs.
- self classNames do:
- [:nm | | cls|
- cls := Smalltalk at: nm.
- (cls notNil and:[cls isLoaded not and:[(abbrevs at:cls name ifAbsent:[nil]) size >= 4]]) ifTrue:
- [cls category:
- ((abbrevs at: cls name) at: 4)]]]
- ]
+ "/ patch the categories
+
+ Class withoutUpdatingChangesDo:[
+ |abbrevs entry|
+
+ abbrevs := self abbrevs.
+ 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)
+ ]
+ ]
+ ]
]
"
stx_libbasic installAutoloadedClasses
stx_libhtml installAutoloadedClasses
+ stx_libtool2 installAutoloadedClasses
"
"Created: / 23-10-2006 / 16:02:12 / cg"
- "Modified: / 08-11-2006 / 17:08:06 / cg"
"Modified: / 06-03-2011 / 18:26:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 18-08-2011 / 15:21:06 / cg"
! !
!ProjectDefinition class methodsFor:'code generation'!
@@ -4512,29 +4539,40 @@
!ProjectDefinition class methodsFor:'private'!
abbrevs
- | abbrevs file stream |
-
- AbbrevDictionary isNil ifTrue:[
- AbbrevDictionary := WeakIdentityDictionary new.
+ "return a dictionary containing my abbreviations;
+ this dictionary is read from my project-directory's abbrev.stc file,
+ and cached for future use"
+
+ |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)
+ ]
+ ]
+ ].
+ ].
].
- [
- abbrevs := AbbrevDictionary at:self ifAbsentPut:[ Dictionary new ].
- ] valueUninterruptably.
-
- file := self packageDirectory / 'abbrev.stc'.
- file exists ifTrue: [
- stream := file readStream.
- [Smalltalk
- withAbbreviationsFromStream:stream
- do:[:nm :fn :pkg :cat :sz|
- abbrevs at: nm put: (Array with: nm with: fn with: pkg with: cat with: sz)]
- ] ensure:[
- stream close
- ]
- ].
+
^abbrevs
"Created: / 06-03-2011 / 18:25:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 18-08-2011 / 14:24:15 / cg"
!
additionalClassAttributesFor: aClass
@@ -5394,27 +5432,32 @@
!
loadClass: className asAutoloaded: asAutoloaded language: lang
-
- | packageDir classFile |
-
- "Handle smalltalk classes specially to provide backward
- compatibility"
+ | packageDir classFile entry category numClassInstVars cls|
+
+ "Handle smalltalk classes specially to provide backward compatibility"
lang isSmalltalk ifTrue:[
- ^asAutoloaded ifTrue:[
- Smalltalk
- installAutoloadedClassNamed: className
- category: ((self abbrevs at: className ifAbsent:[#(nil nil nil #autoloaded)]) at: 4)
- package: self package
- revision: nil
- numClassInstVars: ((self abbrevs at: className ifAbsent:[#(nil nil nil nil 0)]) at: 5)
- ] ifFalse: [
- 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"
@@ -5428,6 +5471,7 @@
"Created: / 19-06-2010 / 09:11:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 06-03-2011 / 18:29:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 18-08-2011 / 14:22:15 / cg"
!
loadClassLibrary
@@ -6345,6 +6389,35 @@
"Modified: / 08-02-2011 / 10:03:49 / cg"
! !
+!ProjectDefinition::AbbrevEntry methodsFor:'accessing'!
+
+category
+ ^ category
+!
+
+className
+ ^ className
+!
+
+className:classNameArg fileName:fileNameArg category:categoryArg numClassInstVars:numClassInstVarsArg
+ className := classNameArg.
+ fileName := fileNameArg.
+ category := categoryArg.
+ numClassInstVars := numClassInstVarsArg.
+
+ "Created: / 18-08-2011 / 14:18:30 / cg"
+!
+
+fileName
+ ^ fileName
+!
+
+numClassInstVars
+ ^ numClassInstVars
+
+ "Created: / 18-08-2011 / 14:18:37 / cg"
+! !
+
!ProjectDefinition class methodsFor:'documentation'!
version
@@ -6352,11 +6425,12 @@
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.342 2011/08/08 13:00:12 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.343 2011/08/18 13:22:44 cg Exp §'
!
version_SVN
- ^ '$Id: ProjectDefinition.st 10666 2011-08-12 12:58:52Z vranyj1 $'
+ ^ '$Id: ProjectDefinition.st 10672 2011-08-20 20:29:33Z vranyj1 $'
! !
ProjectDefinition initialize!
+
--- a/Smalltalk.st Thu Aug 18 10:37:43 2011 +0100
+++ b/Smalltalk.st Sat Aug 20 21:29:33 2011 +0100
@@ -2915,45 +2915,45 @@
But be careful, to not invent new symbols ..."
sym := aString asSymbolIfInterned.
sym notNil ifTrue:[
- cls := self at:sym ifAbsent:nil.
- cls isBehavior ifTrue:[^ cls].
+ cls := self at:sym ifAbsent:nil.
+ cls isBehavior ifTrue:[^ cls].
].
(aString endsWith:' class') ifTrue:[
- nonMeta := self classNamed:(aString copyWithoutLast:6).
- nonMeta notNil ifTrue:[
- ^ nonMeta theMetaclass
- ].
- ].
-
- "no success yet. Try if this is a private classes of an autoloaded class"
+ nonMeta := self classNamed:(aString copyWithoutLast:6).
+ nonMeta notNil ifTrue:[
+ ^ nonMeta theMetaclass
+ ].
+ ].
+
+ "no success yet. Try if this is a private class of an autoloaded class"
cls isNil ifTrue:[
- idx := aString indexOfSubCollection:'::'.
- idx ~~ 0 ifTrue:[
- prefix := aString copyTo:idx-1.
- nsNameSymbol := prefix asSymbolIfInterned.
- nsNameSymbol notNil ifTrue:[
- rest := aString copyFrom:idx+2.
- namespace := self at:prefix asSymbolIfInterned ifAbsent:nil.
- "namespace may be the owner of a private class.
- NameSpaces and Behaviors have the same protocol"
- [namespace isBehavior] whileTrue:[
- idx := rest indexOfSubCollection:'::'.
- idx ~~ 0 ifTrue:[
- prefix := rest copyTo:idx-1.
- rest := rest copyFrom:idx+2.
- "this does an implicit autoload if required"
- namespace := namespace privateClassesAt:prefix.
- ] ifFalse:[
- namespace isLoaded ifTrue:[
- cls := namespace privateClassesAt:rest.
- cls isBehavior ifTrue:[^ cls].
- ].
- namespace := nil. "force exit of loop"
- ].
- ].
- ].
- ].
+ idx := aString indexOfSubCollection:'::'.
+ idx ~~ 0 ifTrue:[
+ prefix := aString copyTo:idx-1.
+ nsNameSymbol := prefix asSymbolIfInterned.
+ nsNameSymbol notNil ifTrue:[
+ rest := aString copyFrom:idx+2.
+ namespace := self at:prefix asSymbolIfInterned ifAbsent:nil.
+ "namespace may be the owner of a private class.
+ NameSpaces and Behaviors have the same protocol"
+ [namespace isBehavior] whileTrue:[
+ idx := rest indexOfSubCollection:'::'.
+ idx ~~ 0 ifTrue:[
+ prefix := rest copyTo:idx-1.
+ rest := rest copyFrom:idx+2.
+ "this does an implicit autoload if required"
+ namespace := namespace privateClassesAt:prefix.
+ ] ifFalse:[
+ namespace isLoaded ifTrue:[
+ cls := namespace privateClassesAt:rest.
+ cls isBehavior ifTrue:[^ cls].
+ ].
+ namespace := nil. "force exit of loop"
+ ].
+ ].
+ ].
+ ].
].
^ nil
@@ -2974,6 +2974,7 @@
"Created: / 24-11-1995 / 17:30:22 / cg"
"Modified: / 19-06-1996 / 14:22:21 / stefan"
"Modified: / 23-10-2006 / 18:06:53 / cg"
+ "Modified (comment): / 20-08-2011 / 16:43:07 / cg"
!
classNames
@@ -3063,6 +3064,16 @@
"Modified: / 10-08-2006 / 13:05:48 / cg"
!
+hasClassNamed:aString
+ Symbol
+ hasInterned:aString
+ ifTrue:[:aSymbol | ^ (self at:aSymbol ifAbsent:[ nil ]) isClass ].
+ ^ false
+
+ "Created: / 26-08-2009 / 11:43:03 / Jaroslav Havlin <havlij6@fel.cvut.cz>"
+ "Modified: / 20-08-2011 / 16:41:31 / cg"
+!
+
hasNameSpaces
"can be redefined by dummy namespaces/environments, to suppress
the namespace display in a browser (PocketSmalltalk)"
@@ -7641,11 +7652,11 @@
!Smalltalk class methodsFor:'documentation'!
version
- ^ '$Id: Smalltalk.st 10669 2011-08-18 09:37:43Z vranyj1 $'
+ ^ '$Id: Smalltalk.st 10672 2011-08-20 20:29:33Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.972 2011/08/18 07:19:06 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.974 2011/08/20 14:43:25 cg Exp §'
!
version_SVN
@@ -7654,3 +7665,4 @@
+
--- a/StandaloneStartup.st Thu Aug 18 10:37:43 2011 +0100
+++ b/StandaloneStartup.st Sat Aug 20 21:29:33 2011 +0100
@@ -448,9 +448,14 @@
"answer an application-specific unique uuid.
This is used as the name of some exclusive OS-resource, which is used to find out,
if another instance of this application is already running.
- Under win32, a mutex is used; under unix, an exclusive file in the tempDir could be used."
+ Under win32, a mutex is used; under unix, an exclusive file in the tempDir could be used.
+ If redefined, please return a real UUID (i.e. UUID fromString:'.....') and not a string or
+ similar possibly conflicting identifier.
+ You can paste a fresh worldwide unique id via the editor's more-misc-paste UUID menuFunction."
self subclassResponsibility
+
+ "Modified (comment): / 19-08-2011 / 01:54:39 / cg"
!
shouldReuseRunningApplication
@@ -1133,12 +1138,13 @@
!StandaloneStartup class methodsFor:'documentation'!
version
- ^ '$Id: StandaloneStartup.st 10669 2011-08-18 09:37:43Z vranyj1 $'
+ ^ '$Id: StandaloneStartup.st 10672 2011-08-20 20:29:33Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/StandaloneStartup.st,v 1.65 2011/08/11 15:26:10 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/StandaloneStartup.st,v 1.66 2011/08/18 23:54:49 cg Exp §'
! !
StandaloneStartup initialize!
+
--- a/Time.st Thu Aug 18 10:37:43 2011 +0100
+++ b/Time.st Sat Aug 20 21:29:33 2011 +0100
@@ -71,6 +71,12 @@
!Time class methodsFor:'instance creation'!
+fromString: aString
+ ^ self readFrom: (ReadStream on: aString).
+
+ "Modified (format): / 20-08-2011 / 16:46:39 / cg"
+!
+
hour:h minute:m
"compatibility"
@@ -290,7 +296,6 @@
^ '%h:%m:%s'
! !
-
!Time methodsFor:'Compatibility-Squeak'!
intervalString
@@ -779,13 +784,13 @@
timeEncoding := encoding
! !
-
!Time class methodsFor:'documentation'!
version
- ^ '$Id: Time.st 10660 2011-07-18 15:22:09Z vranyj1 $'
+ ^ '$Id: Time.st 10672 2011-08-20 20:29:33Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Time.st,v 1.89 2011/01/24 19:56:23 stefan Exp §'
+ ^ 'Header: /cvs/stx/stx/libbasic/Time.st,v 1.90 2011/08/20 14:47:15 cg Exp '
! !
+
--- a/Timestamp.st Thu Aug 18 10:37:43 2011 +0100
+++ b/Timestamp.st Sat Aug 20 21:29:33 2011 +0100
@@ -93,6 +93,11 @@
initialize
AbsoluteTime := self. "backward compatibility"
+ DateAndTime isNil ifTrue:[
+ DateAndTime := self
+ ].
+
+ "Modified: / 20-08-2011 / 18:43:51 / cg"
! !
!Timestamp class methodsFor:'instance creation'!
@@ -284,10 +289,38 @@
"Modified: / 13.7.1999 / 12:37:57 / stefan"
! !
+
!Timestamp class methodsFor:'Compatibility-Squeak'!
current
^ self now
+!
+
+fromString: aString
+ "Answer a new instance for the value given by aString"
+
+ ^ self readFrom: (ReadStream on: aString).
+
+ "
+ Timestamp fromString: '1-10-2000 11:55:00 am'.
+ "
+
+ "Modified (format): / 20-08-2011 / 16:51:53 / cg"
+!
+
+readFrom:aStringOrStream
+ "Answer a new instance for the value given by aStringOrStream"
+
+ ^ self
+ readFrom:aStringOrStream
+ onError:[ ConversionError raiseRequestErrorString:'conversion error']
+
+ "
+ self readFrom:'23-jun-2000 15:00'
+ self readFrom:'23-jun-2000 '
+ "
+
+ "Modified (comment): / 20-08-2011 / 16:52:10 / cg"
! !
!Timestamp class methodsFor:'obsolete'!
@@ -2659,12 +2692,13 @@
!Timestamp class methodsFor:'documentation'!
version
- ^ '$Id: Timestamp.st 10665 2011-08-10 14:59:08Z vranyj1 $'
+ ^ '$Id: Timestamp.st 10672 2011-08-20 20:29:33Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Timestamp.st,v 1.138 2011/08/01 14:40:24 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Timestamp.st,v 1.140 2011/08/20 16:45:03 cg Exp §'
! !
Timestamp initialize!
+
--- a/True.st Thu Aug 18 10:37:43 2011 +0100
+++ b/True.st Sat Aug 20 21:29:33 2011 +0100
@@ -55,6 +55,12 @@
"
! !
+!True class methodsFor:'others'!
+
+version_CVS
+ ^ '§Header: /cvs/stx/stx/libbasic/True.st,v 1.30 2011/08/20 14:32:02 cg Exp §'
+! !
+
!True methodsFor:'conditional evaluation'!
@@ -73,7 +79,10 @@
"evaluate block1 if the receiver is true,
if that is also true, return the result from block2."
- ^ block1 value and:block2
+ block1 value ifFalse: [^ false].
+ ^ block2 value
+
+ "Modified: / 20-08-2011 / 16:31:27 / cg"
!
and:block1 and:block2 and:block3
@@ -237,5 +246,6 @@
!True class methodsFor:'documentation'!
version
- ^ '$Id: True.st 10660 2011-07-18 15:22:09Z vranyj1 $'
+ ^ '$Id: True.st 10672 2011-08-20 20:29:33Z vranyj1 $'
! !
+
--- a/UserPreferences.st Thu Aug 18 10:37:43 2011 +0100
+++ b/UserPreferences.st Sat Aug 20 21:29:33 2011 +0100
@@ -2224,30 +2224,36 @@
k := aMessage selector.
aMessage numArgs == 0 ifTrue:[
- (self includesKey:k) ifTrue:[
- ^ self at:k
- ].
- ((def := self class default) includesKey:k) ifTrue:[
- ^ def at:k
- ].
- ^ self defaultValue
+ (self includesKey:k) ifTrue:[
+ ^ self at:k
+ ].
+ ((def := self class default) includesKey:k) ifTrue:[
+ ^ def at:k
+ ].
+ ^ self defaultValue
].
-"/ ((aMessage numArgs == 1)
-"/ and:[ (k endsWith:$:)])
-"/ ifTrue:[
-"/ k := (k copyWithoutLast:1) asSymbol.
-"/ ((self includesKey:k)
-"/ or:[ self class default includesKey:k ]) ifTrue:[
-"/ ^ self at:k put:(aMessage arg1)
-"/ ].
-"/ ].
+
+ "/ this is needed, if a setting is loaded (via the settings.stx) at a time
+ "/ when the corresponding package which uses that setting is not yet loaded;
+ "/ for example: libsvn settings, with no libsvn being present.
+ "/ if obsolete keys accumulate over time, we might need a settings cleanup GUI to
+ "/ care for that.
+
+ ((aMessage numArgs == 1)
+ and:[ (k endsWith:$:)])
+ ifTrue:[
+ k := (k copyWithoutLast:1) asSymbol.
+ ^ self at:k put:(aMessage arg1)
+ ].
aMessage numArgs == 1 ifTrue:[
- ('UserPreferences [info]: obsolete settings key: ' , aMessage selector , ' - ignored.') infoPrintCR.
- ^ nil
+ ('UserPreferences [info]: obsolete settings key: ' , aMessage selector , ' - ignored.') infoPrintCR.
+ ^ nil
].
^ super doesNotUnderstand:aMessage
+
+ "Modified (comment): / 19-08-2011 / 14:01:56 / cg"
!
emphasis:e andColor:c
@@ -3406,6 +3412,23 @@
^ self at:#verboseBacktraceInDebugger put:aBoolean
! !
+!UserPreferences methodsFor:'accessing-source code management'!
+
+showBadRevisionStringDialogs
+ "show a dialog when a bad revision string is encountered, or silently fix it"
+
+ ^ self at: #'showBadRevisionStringDialogs' ifAbsent:true
+
+ "Created: / 19-08-2011 / 12:51:25 / cg"
+!
+
+showBadRevisionStringDialogs:aBoolean
+ "show a dialog when a bad revision string is encountered, or silently fix it"
+
+ ^ self at: #'showBadRevisionStringDialogs' put:aBoolean
+
+ "Created: / 19-08-2011 / 12:51:58 / cg"
+! !
!UserPreferences methodsFor:'default settings - syntax colors'!
@@ -3627,7 +3650,7 @@
!UserPreferences class methodsFor:'documentation'!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/UserPreferences.st,v 1.285 2011/08/04 19:38:06 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/UserPreferences.st,v 1.287 2011/08/19 12:03:39 cg Exp §'
!
version_SVN
@@ -3635,3 +3658,4 @@
! !
+
--- a/stx_libbasic.st Thu Aug 18 10:37:43 2011 +0100
+++ b/stx_libbasic.st Sat Aug 20 21:29:33 2011 +0100
@@ -541,7 +541,7 @@
"Return a SVN revision number of myself.
This number is updated after a commit"
- ^ "$SVN-Revision:"'10667M'"$"
+ ^ "$SVN-Revision:"'10670M'"$"
! !
!stx_libbasic class methodsFor:'documentation'!