--- a/ProjectDefinition.st Mon Jun 05 16:36:56 2017 +0100
+++ b/ProjectDefinition.st Fri Aug 11 12:06:04 2017 +0100
@@ -1472,18 +1472,47 @@
the class is installed as autoloaded in the image (i.e. the state in the image is taken).
If false, it is taken from an existing definition in #classNamesAndAttributes"
- |newSpec oldSpec ignored|
+ | newSpec oldSpec ignored renames |
oldSpec := self classNamesAndAttributesAsSpecArray.
ignored := self ignoredClassNames asSet.
newSpec := OrderedCollection new.
+ renames := Dictionary new.
+
+ "/ We must preserve attributes across class renames (imagine
+ "/ a platform-specific class is renamed). Generally it's not
+ "/ possible to reliably detect renames but we're doing our best
+ "/ by looking at session changeset. This works fine as long as
+ "/ one uses refactorings to rename classes - which she should
+ "/ anyeay!!
+ "/
+ "/ So here we create a mapping from old class name (currently in
+ "/ a spec) to a new class name (to appear in new spec). This map
+ "/ is used later to look up old class entry for (renamed) class
+ "/ and copy attributes over.
+ ChangeSet current do:[:chg|
+ chg isClassRenameChange ifTrue:[
+ | oldName newName |
+
+ oldName := renames keyAtValue: chg oldName ifAbsent:[ chg oldName ].
+ newName := chg className.
+ oldName = newName ifTrue:[
+ renames removeKey: oldName
+ ] ifFalse:[
+ renames at: oldName put: newName.
+ ]
+ ].
+ ].
ignoreOldEntries ifFalse:[
oldSpec do:[:oldEntry |
- |newEntry className cls |
+ | newEntry className cls |
newEntry := oldEntry copy.
- className := newEntry first.
+ "/ If (old) class has been renamed, add a new entry with new name
+ "/ and old attributes...
+ className := renames at: oldEntry first ifAbsent:[ oldEntry first ].
+ newEntry at: 1 put: className.
(ignored includes:className) ifFalse:[
cls := Smalltalk classNamed:className.
@@ -1499,7 +1528,22 @@
Force merge default class attributes with existing ones"
newEntry := self mergeDefaultClassAttributesFor: cls with: newEntry.
newSpec add:newEntry.
- ]
+ ] ifFalse:[
+ "/ Class named `className` is not present. This can be either
+ "/ because:
+ "/ * it has been deleted or
+ "/ * it's a platform specific class for some other platform
+ "/ than current one.
+ "/
+ "/ If the latter, we MUST preserve it in class list.
+ | keep |
+
+ keep := oldEntry anySatisfy:[:e | e ~~ className and:[ e ~~ #autoload and: [ e ~~ OperatingSystem platformName ]]].
+ keep ifTrue:[
+ "Force merge default class attributes with existing ones"
+ newSpec add:newEntry.
+ ].
+ ].
].
].
].
@@ -1509,7 +1553,10 @@
eachClass isJavaClass ifFalse:[
className := eachClass name.
(ignored includes:className) ifFalse:[
- oldSpecEntry := oldSpec detect:[:entry | entry first = className] ifNone:nil.
+ | oldClassName |
+
+ oldClassName := renames keyAtValue: className ifAbsent:[ className ].
+ oldSpecEntry := oldSpec detect:[:entry | entry first = oldClassName] ifNone:nil.
(ignoreOldEntries or:[oldSpecEntry isNil]) ifTrue:[
(eachClass isLoaded not or:[eachClass isPrivate not]) ifTrue:[
@@ -1561,7 +1608,7 @@
"Modified: / 08-08-2006 / 19:24:34 / fm"
"Created: / 10-10-2006 / 22:00:50 / cg"
"Modified: / 06-09-2011 / 07:48:52 / cg"
- "Modified: / 30-07-2014 / 20:40:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 27-07-2017 / 10:56:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
companyName_code
--- a/Registry.st Mon Jun 05 16:36:56 2017 +0100
+++ b/Registry.st Fri Aug 11 12:06:04 2017 +0100
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1993,2015 by Claus Gittinger
All Rights Reserved
@@ -286,6 +284,68 @@
"Modified: 30.1.1997 / 15:04:34 / cg"
"Modified: 1.10.1997 / 11:25:32 / stefan"
+!
+
+grow:newSize
+ "Grow the receiver to make space for at least newSize elements.
+ To do this, we have to rehash into the new arrays. (which is done
+ by re-adding all elements to a new, empty key/value array pair).
+
+ Redefined here again to avoid higher-prio process to modify the
+ receiver while grwoing and to handle corpses.
+ "
+
+
+ | key deletedEntry oldKeyArray oldValueArray n
+ oldSize "{ Class:SmallInteger }"
+ newIndex "{ Class:SmallInteger }"
+ wasBlocked
+ executors |
+
+ oldKeyArray := keyArray.
+ oldValueArray := valueArray.
+
+ n := self class goodSizeFrom:newSize.
+ oldSize := oldKeyArray size.
+ n == oldSize ifTrue:[^ self].
+
+ keyArray := self keyContainerOfSize:n.
+ valueArray := self valueContainerOfSize:n.
+
+
+ deletedEntry := DeletedEntry.
+ wasBlocked := OperatingSystem blockInterrupts.
+ 1 to:oldSize do:[:index |
+ key := oldKeyArray basicAt:index.
+ (key notNil and:[key ~~ deletedEntry]) ifTrue:[
+ key class == SmallInteger ifTrue:[
+ "/ Oops, we found a corpse, register it
+ "/ and continue.
+ tally := tally - 1.
+ executors isNil ifTrue:[
+ executors := OrderedCollection new.
+ ].
+ executors add:(oldValueArray basicAt:index).
+ ] ifFalse:[
+ newIndex := self findNil:key.
+ keyArray basicAt:newIndex put:key.
+ valueArray basicAt:newIndex put:(oldValueArray basicAt:index).
+ ].
+ ]
+ ].
+ wasBlocked ifFalse:[ OperatingSystem unblockInterrupts ].
+ executors notNil ifTrue:[
+ executors do:[:eachExecutor|
+ [
+ self informDispose:eachExecutor.
+ ] on:Error do:[:ex|
+ Logger error:'Error %1 during finalization of: %2' with:ex description with:eachExecutor.
+ ex suspendedContext fullPrintAllLevels:10.
+ ].
+ ].
+ ].
+
+ "Created: / 31-07-2017 / 09:19:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Registry methodsFor:'registering objects'!
--- a/UserPreferences.st Mon Jun 05 16:36:56 2017 +0100
+++ b/UserPreferences.st Fri Aug 11 12:06:04 2017 +0100
@@ -129,28 +129,40 @@
"Created: / 06-06-2016 / 10:42:14 / cg"
! !
+!UserPreferences class methodsFor:'instance creation'!
+
+new
+ "return an initialized instance"
+
+ ^ super new initialize.
+
+ "Modified: / 07-06-2017 / 11:34:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!UserPreferences class methodsFor:'accessing'!
current
CurrentPreferences isNil ifTrue:[
CurrentPreferences := self new.
- self initializeDefaultsIn:CurrentPreferences.
CurrentPreferences flyByHelpSettingChanged.
].
- ^ CurrentPreferences.
+ "/ The #value message allows CurrentPrefences to be a block (or anything
+ "/ that responds to #value) that returns different preferences in different
+ "/ contexts. For example, each screen might have different user with
+ "/ different settings.
+ ^ CurrentPreferences value.
"
CurrentPreferences := nil
"
- "Modified: / 05-02-2015 / 07:08:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 06-06-2016 / 10:42:59 / cg"
+ "Modified: / 07-06-2017 / 12:38:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
default
DefaultPreferences isNil ifTrue:[
DefaultPreferences := self new.
- self initializeDefaultsIn:DefaultPreferences
].
^ DefaultPreferences.
@@ -159,6 +171,7 @@
"
"Modified: / 06-06-2016 / 10:41:45 / cg"
+ "Modified: / 07-06-2017 / 11:33:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
reset
@@ -474,9 +487,40 @@
!UserPreferences class methodsFor:'accessing - defaults'!
defaultUserSettingsFile
- ^ (Filename usersPrivateSmalltalkDirectory) / 'settings.stx'
+ "Return default user settings file."
+
+ ^self defaultUserSettingsFileLocations first.
+ "
+ UserPreferences defaultUserSettingsFile
+ "
"Created: / 06-10-2008 / 08:27:15 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 07-06-2017 / 11:29:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 07-06-2017 / 21:47:46 / jv"
+!
+
+defaultUserSettingsFileLocations
+ "Return list of files which are probed when looking for
+ saved user settings.
+
+ The location changed over the time. To be backward
+ compatible, return all of them.
+ "
+ ^ {
+ (Filename usersPrivateSmalltalkDirectory / 'settings.stx') . "/ per-user settings file (new default?)
+ (Filename usersPrivateSmalltalkDirectory / 'settings.rc') . "/ for backward compatibility with jv-branch
+ } , (
+ Smalltalk realSystemPath collect: [ :e|e asFilename / 'settings.stx']"/ per-user settings file (new default?)
+ ) , (
+ Smalltalk realSystemPath collect: [ :e|e asFilename / 'settings.rc'] "/ for backward compatibility with jv-branch
+ )
+
+ "
+ UserPreferences defaultUserSettingsFileLocations
+ "
+
+ "Created: / 07-06-2017 / 21:46:43 / jv"
+ "Modified: / 31-07-2017 / 20:48:28 / jv"
!
defaultWorkspaceDirectory
@@ -517,7 +561,92 @@
"
! !
-!UserPreferences class methodsFor:'saving'!
+!UserPreferences class methodsFor:'load / save'!
+
+loadSettings
+ "Load and return default user settings. Probe all files specified specified
+ in #defaultUserSettingsFileLocations. First found is used, the rest is ignored.
+ "
+
+ self defaultUserSettingsFileLocations do:[:file |
+ file exists ifTrue:[
+ file isDirectory ifTrue:[
+ Logger warning: 'user settings file is actually a directory: %1' with: file pathName.
+ ] ifFalse:[
+ file isReadable ifFalse:[
+ Logger warning: 'user settings file is not readable, skipping: %1' with: file pathName.
+ ] ifTrue:[
+ ^ self loadSettingsFrom: file
+ ].
+ ]
+ ]
+ ].
+ ^ self new.
+
+ "
+ UserPreferences loadSettings.
+ "
+
+ "Created: / 07-06-2017 / 11:50:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 07-06-2017 / 21:50:56 / jv"
+!
+
+loadSettingsFrom: aStringOrFilename
+ "Load previously stored settings from given file. Returns loaded settings."
+
+ | prefsFile prefs currentProcess currentPrefs |
+
+ prefsFile := aStringOrFilename.
+ (prefsFile isReadable not or:[prefsFile isRegularFile not]) ifTrue:[
+ self error: 'File not readable or not a regular file'
+ ].
+ "/ Currently format of user preferences is actually an executable
+ "/ smalltalk code that is evaluated. That code fills in values in
+ "/ `UserPreferences current`. This way, it's not possible to load
+ "/ previously saved preferences to some other objects.
+ "/
+ "/ So, in order to load preferences we need to temporarily
+ "/ swap `UserPreferences current` to pristine instance, load
+ "/ preferences and then restore old preferences.
+ "/
+ "/ Things are more complicated since someone may access preferences
+ "/ while loading. Therefore, answer old preferences except for
+ "/ current process which is loading new ones.
+ "/
+ "/ What a hack!!
+ currentPrefs := CurrentPreferences.
+ currentProcess := Processor activeProcess.
+ [
+ prefs := self new.
+ CurrentPreferences := [
+ Processor activeProcess == currentProcess
+ ifTrue:[ prefs ]
+ ifFalse:[ currentPrefs value ]
+ ].
+ prefsFile fileIn.
+ prefs at:#settingsFilename put: prefsFile pathName.
+ ] ensure:[
+ CurrentPreferences := currentPrefs.
+ ].
+ ^ prefs
+
+ "
+ UserPreferences loadSettingsFrom: self defaultUserSettingsFile.
+
+ | file |
+
+ file := Filename newTemporary.
+ [
+ file writingFileDo:[:s| s nextPutLine: 'UserPreferences current at: #xxx put: #yyy' ].
+ UserPreferences loadSettingsFrom: file
+ ] ensure:[
+ file remove.
+ ].
+ "
+
+ "Created: / 07-06-2017 / 11:46:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 07-06-2017 / 13:25:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
saveSettings:userPrefs in:fileNameOrString
"save settings to a settings-file."
@@ -874,6 +1003,7 @@
+
!UserPreferences methodsFor:'accessing-locale'!
dateInputFormat
@@ -5670,6 +5800,8 @@
! !
+
+
!UserPreferences methodsFor:'default settings-syntax colors'!
listOfPredefinedSyntaxColoringSchemes
@@ -5899,6 +6031,16 @@
^ self defaultValue
! !
+!UserPreferences methodsFor:'initialization'!
+
+initialize
+ super initialize.
+ self class initializeDefaultsIn: self.
+ self beUnmodified.
+
+ "Modified: / 07-06-2017 / 11:32:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!UserPreferences methodsFor:'misc'!
doesNotUnderstand:aMessage
@@ -5986,6 +6128,11 @@
^ '$Header$'
!
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+!
+
version_SVN
^ '$ Id: UserPreferences.st 10648 2011-06-23 15:55:10Z vranyj1 $'
! !
--- a/WeakIdentityDictionary.st Mon Jun 05 16:36:56 2017 +0100
+++ b/WeakIdentityDictionary.st Fri Aug 11 12:06:04 2017 +0100
@@ -423,25 +423,57 @@
!
grow:newSize
- "grow the receiver.
- Redefined to block interrupts, to avoid trouble when dependencies
- are added within interrupting high prio processes."
+ "Grow the receiver to make space for at least newSize elements.
+ To do this, we have to rehash into the new arrays. (which is done
+ by re-adding all elements to a new, empty key/value array pair).
+
+ Redefined here to avoid higher-prio process to modify the receiver while
+ grwoing and to handle corpses.
+ "
+
+
+ | key deletedEntry oldKeyArray oldValueArray n
+ oldSize "{ Class:SmallInteger }"
+ newIndex "{ Class:SmallInteger }"
+ wasBlocked
+ anyDead |
+
+ oldKeyArray := keyArray.
+ oldValueArray := valueArray.
+
+ n := self class goodSizeFrom:newSize.
+ oldSize := oldKeyArray size.
+ n == oldSize ifTrue:[^ self].
-"/ 'grow:' printCR.
+ keyArray := self keyContainerOfSize:n.
+ valueArray := self valueContainerOfSize:n.
+
- (OperatingSystem blockInterrupts) ifTrue:[
- "/ already blocked
- ^ super grow:newSize.
+ deletedEntry := DeletedEntry.
+ anyDead := false.
+ wasBlocked := OperatingSystem blockInterrupts.
+ 1 to:oldSize do:[:index |
+ key := oldKeyArray basicAt:index.
+ (key notNil and:[key ~~ deletedEntry]) ifTrue:[
+ key class == SmallInteger ifTrue:[
+ "/ Oops, we found a corpse, make a note
+ "/ and continue.
+ anyDead := true.
+ ] ifFalse:[
+ newIndex := self findNil:key.
+ keyArray basicAt:newIndex put:key.
+ valueArray basicAt:newIndex put:(oldValueArray basicAt:index).
+ ].
+ ]
+ ].
+ wasBlocked ifFalse:[ OperatingSystem unblockInterrupts ].
+ anyDead ifTrue:[
+ self changed:#ElementExpired
].
- [
- super grow:newSize
- ] ensure:[
- OperatingSystem unblockInterrupts
- ].
-
- "Created: 28.1.1997 / 23:41:39 / cg"
- "Modified: 29.1.1997 / 15:10:12 / cg"
+ "Created: / 28-01-1997 / 23:41:39 / cg"
+ "Modified: / 29-01-1997 / 15:10:12 / cg"
+ "Modified: / 31-07-2017 / 09:16:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
initializeForCapacity:minSize
@@ -571,5 +603,10 @@
version_CVS
^ '$Header$'
+!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
! !
--- a/stx_libbasic.st Mon Jun 05 16:36:56 2017 +0100
+++ b/stx_libbasic.st Fri Aug 11 12:06:04 2017 +0100
@@ -397,9 +397,9 @@
UninterpretedBytes
(UnixFileDescriptorHandle unix)
(UnixFileHandle unix)
- UnixTerminalAttributes
- UnixTerminalConstants
- UnixOperatingSystem
+ TTYAttributes
+ TTYConstants
+ (UnixOperatingSystem unix)
UserInformation
UtcTimestamp
VMInternalError
@@ -677,3 +677,4 @@
^ '$ Id: stx_libbasic.st 10648 2011-06-23 15:55:10Z vranyj1 $'
! !
+