The Trunk: System-ul.411.mcz

Levente Uzonyi uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-ul.411.mcz

==================== Summary ====================

Name: System-ul.411
Author: ul
Time: 10 January 2011, 4:38:07.417 pm
UUID: 4fc51c8b-58f7-a541-a57a-65f3aa38ca24
Ancestors: System-cmm.410

- ensure that DictionaryOfPreferences (a class variable of Preferences) is not accessed concurrently when it's possible. The goal is to keep the integrity of the dictionary. See http://bugs.squeak.org/view.php?id=7593 .

=============== Diff against System-cmm.410 ===============

Item was changed:
  Object subclass: #Preferences
  instanceVariableNames: ''
+ classVariableNames: 'AccessLock DesktopColor DictionaryOfPreferences Parameters'
- classVariableNames: 'DesktopColor DictionaryOfPreferences Parameters'
  poolDictionaries: ''
  category: 'System-Preferences'!
 
  !Preferences commentStamp: '<historical>' prior: 0!
  A general mechanism to store preference choices.  The default setup treats any symbol as a potential boolean flag; flags unknown to the preference dictionary are always returned as false.  
 
  To open the control panel: Preferences openFactoredPanel
  To read how to use the panel (and how to make a preference be per-project):
  Preferences giveHelpWithPreferences
 
  All messages are on the class side.
 
  To query a a preference:
  Preferences logDebuggerStackToFile
  or some people prefer the more verbose
  Preferences valueOfFlag: #logDebuggerStackToFile
 
  You can make up a new preference any time.  Do not define a new message in Preferences class. Accessor methods are compiled automatically when you add a preference as illustrated below:
 
  To add a preference (e.g. in the Postscript of a fileout):
  Preferences addPreference: #samplePreference categories: #(general browsing)
  default: true balloonHelp: 'This is an example of a preference added by a do-it'
  projectLocal: false changeInformee: nil changeSelector: nil.
 
  To change a preference programatically:
  Preferences disable: #logDebuggerStackToFile.
  Or to turn it on,
  Preferences enable: #logDebuggerStackToFile.
  !

Item was added:
+ ----- Method: Preferences class>>accessDictionaryOfPreferencesIn: (in category 'accessing') -----
+ accessDictionaryOfPreferencesIn: aBlock
+
+ ^(AccessLock ifNil: [ AccessLock := Mutex new ])
+ critical: [ aBlock value: DictionaryOfPreferences ]!

Item was changed:
  ----- Method: Preferences class>>addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector:type: (in category 'add preferences') -----
  addPreference: aName categories: categoryList default: aValue balloonHelp: helpString projectLocal: localBoolean changeInformee: informeeSymbol changeSelector: aChangeSelector type: aType
  "Add or replace a preference as indicated.  Reuses the preexisting Preference object for this symbol, if there is one, so that UI artifacts that interact with it will remain valid."
 
  | aPreference aPrefSymbol |
  aPrefSymbol := aName asSymbol.
+ aPreference := self accessDictionaryOfPreferencesIn: [ :dictionaryOfPreferences |
+ dictionaryOfPreferences
+ at:aPrefSymbol
+ ifAbsent: [ Preference new ] ].
- aPreference := self dictionaryOfPreferences  at:aPrefSymbol
- ifAbsent:[Preference new].
  aPreference
  name:aPrefSymbol
  defaultValue:aValue
  helpString:helpString
  localToProject:localBoolean
  categoryList:categoryList
  changeInformee:informeeSymbol
  changeSelector:aChangeSelector
  type: aType.
+ self accessDictionaryOfPreferencesIn: [ :dictionaryOfPreferences |
+ dictionaryOfPreferences at: aPrefSymbol put: aPreference ].
- self dictionaryOfPreferences  at:aPrefSymbol  put:aPreference.
  self  compileAccessMethodForPreference:aPreference!

Item was changed:
  ----- Method: Preferences class>>allPreferenceObjects (in category 'preference-object access') -----
  allPreferenceObjects
  "Answer a list of all the Preference objects registered in the system"
 
+ ^self accessDictionaryOfPreferencesIn: [ :dictionaryOfPreferences |
+ dictionaryOfPreferences values ]!
- ^ self dictionaryOfPreferences values!

Item was changed:
  ----- Method: Preferences class>>categoryNames (in category 'preferences panel') -----
  categoryNames
+
  | aSet |
  aSet := Set new.
+ self allPreferenceObjects do: [ :aPreference |
+ aSet addAll: (
+ aPreference categoryList collect: [ :aCategory |
+ aCategory asSymbol ]) ].
+ ^aSet!
- self dictionaryOfPreferences  do:
- [:aPreference |
- aSet  addAll:(aPreference categoryList
- collect:[:aCategory | aCategory asSymbol])].
- ^ aSet!

Item was changed:
  ----- Method: Preferences class>>dictionaryOfPreferences (in category 'accessing') -----
  dictionaryOfPreferences
+ "The use of this accessor doesn't ensure that the dictionary is not accessed concurrently. Use #accessDictionaryOfPreferencesIn: instead."
+
  ^DictionaryOfPreferences!

Item was changed:
  ----- Method: Preferences class>>inspectPreferences (in category 'preferences panel') -----
  inspectPreferences
+ "Open a window on the current preferences dictionary, allowing the user to inspect and change the current preference settings.  This is fallen back upon if Morphic is not present. This is dangerous, the dictionary of preferences should not be accessed concurrently."
- "Open a window on the current preferences dictionary, allowing the user to inspect and change the current preference settings.  This is fallen back upon if Morphic is not present"
 
  "Preferences inspectPreferences"
 
+ self dictionaryOfPreferences inspectWithLabel:'Preferences'!
- self dictionaryOfPreferences  inspectWithLabel:'Preferences'!

Item was changed:
  ----- Method: Preferences class>>prefEvent: (in category 'dynamic preferences') -----
  prefEvent: anEvent
  "Check if this system event defines or removes a preference.
  TODO: Queue the event and handle in background process.
  There is zero reason to be so eager here."
  | aClass aSelector prefSymbol method |
  (anEvent itemKind = SystemChangeNotifier classKind and: [anEvent isRemoved])
  ifTrue:[self removePreferencesFor: anEvent item].
  anEvent itemKind = SystemChangeNotifier methodKind ifTrue:[
  aClass := anEvent itemClass.
  aClass isMeta ifFalse:[^self]. "ignore instance methods"
  aClass := aClass theNonMetaClass.
  aSelector := anEvent itemSelector.
  (anEvent isRemoved or:[anEvent isModified]) ifTrue:[
  prefSymbol := (aClass name,'>>', aSelector) asSymbol.
+ self accessDictionaryOfPreferencesIn: [ :dictionaryOfPreferences |
+ dictionaryOfPreferences removeKey: prefSymbol ifAbsent:[] ] ].
- self dictionaryOfPreferences removeKey: prefSymbol ifAbsent:[]].
  (anEvent isAdded or:[anEvent isModified]) ifTrue:[
  method := anEvent item.
  method pragmas do:[:pragma| | aPreference aPrefSymbol |
  pragma keyword == #preference:category:description:type: ifTrue:[
  aPrefSymbol := (aClass name,'>>', method selector) asSymbol.
  aPreference := self
  preference: pragma arguments first
  category: pragma arguments second
  description: pragma arguments third
  type: pragma arguments fourth.
  aPreference
  provider: aClass
  getter: method selector
  setter: method selector asMutator.
+ self accessDictionaryOfPreferencesIn: [ :dictionaryOfPreferences |
+ dictionaryOfPreferences at: aPrefSymbol put: aPreference ] ] ] ] ].
- self dictionaryOfPreferences at: aPrefSymbol put: aPreference]]]].
  !

Item was changed:
  ----- Method: Preferences class>>preferenceAt: (in category 'preference-object access') -----
  preferenceAt: aSymbol
  "Answer the Preference object at the given symbol, or nil if not there"
 
+ ^self preferenceAt: aSymbol ifAbsent: [ nil ]!
- ^ self dictionaryOfPreferences  at:aSymbol  ifAbsent:[nil]!

Item was changed:
  ----- Method: Preferences class>>preferenceAt:ifAbsent: (in category 'preference-object access') -----
  preferenceAt: aSymbol ifAbsent: aBlock
  "Answer the Preference object at the given symbol, or the value of aBlock if not present"
 
+ ^self accessDictionaryOfPreferencesIn: [ :dictionaryOfPreferences |
+ dictionaryOfPreferences at: aSymbol ifAbsent: aBlock ]!
- ^ self dictionaryOfPreferences  at:aSymbol  ifAbsent:[aBlock value]!

Item was changed:
  ----- Method: Preferences class>>preferenceObjectsInCategory: (in category 'preferences panel') -----
  preferenceObjectsInCategory: aCategorySymbol
+ "Answer a list of Preference objects that reside in the given category."
- "Answer a list of Preference objects that reside in the given category, in alphabetical order"
 
+ ^self allPreferenceObjects select: [ :aPreference |
+ aPreference categoryList includes: aCategorySymbol ]!
- ^ (self dictionaryOfPreferences
- select:[:aPreference | aPreference categoryList  includes:aCategorySymbol])!

Item was changed:
  ----- Method: Preferences class>>registerForEvents (in category 'dynamic preferences') -----
  registerForEvents
  "Preferences registerForEvents"
 
  SystemChangeNotifier uniqueInstance noMoreNotificationsFor: self.
  SystemChangeNotifier uniqueInstance notify: self ofAllSystemChangesUsing: #prefEvent:.
  Smalltalk allClassesDo:[:aClass|
  aClass class methodsDo:[:method|
  method pragmas do:[:pragma| | aPreference aPrefSymbol |
  pragma keyword == #preference:category:description:type: ifTrue:[
  aPrefSymbol := (aClass name,'>>', method selector) asSymbol.
  aPreference := self
  preference: pragma arguments first
  category: pragma arguments second
  description: pragma arguments third
  type: pragma arguments fourth.
  aPreference
  provider: aClass
  getter: method selector
  setter: method selector asMutator.
+ self accessDictionaryOfPreferencesIn: [ :dictionaryOfPreferences |
+ dictionaryOfPreferences at: aPrefSymbol put: aPreference ] ] ] ] ].
- self dictionaryOfPreferences at: aPrefSymbol put: aPreference]]]].
  !

Item was changed:
  ----- Method: Preferences class>>removePreference: (in category 'initialization') -----
  removePreference: aSymbol
  "Remove all memory of the given preference symbol in my various structures."
 
  | pref |
  pref := self  preferenceAt:aSymbol  ifAbsent:[^ self].
  pref localToProject
  ifTrue:
  [Project  allInstancesDo:
  [:proj |
  proj projectPreferenceFlagDictionary  ifNotNil:
  [proj projectPreferenceFlagDictionary  removeKey:aSymbol  ifAbsent:[]]]].
+ self accessDictionaryOfPreferencesIn: [ :dictionaryOfPreferences |
+ dictionaryOfPreferences removeKey: aSymbol ifAbsent: [] ].
- self dictionaryOfPreferences  removeKey:aSymbol  ifAbsent:[].
  self class  removeSelector:aSymbol
 
  "Preferences removePreference: #tileToggleInBrowsers"!

Item was changed:
  ----- Method: Preferences class>>removePreferencesFor: (in category 'dynamic preferences') -----
  removePreferencesFor: aClass
  "Remove all the preferences registered for the given class"
  "Preferences removePreferencesFor: PreferenceExample"
+
+ self accessDictionaryOfPreferencesIn: [ :dictionaryOfPreferences |
+ | map |
+ map := dictionaryOfPreferences select: [ :pref | pref provider == aClass ].
+ map keysDo: [ :prefName | dictionaryOfPreferences removeKey: prefName ] ]!
- | map |
- map := self dictionaryOfPreferences select:[:pref| pref provider == aClass].
- map keysDo:[:prefName| self dictionaryOfPreferences removeKey: prefName].!

Item was changed:
  ----- Method: Preferences class>>savePersonalPreferences (in category 'personalization') -----
  savePersonalPreferences
  "Save the current list of Preference settings as the user's personal choices"
 
+ self
+ setParameter:#PersonalDictionaryOfPreferences
+ to: (
+ self accessDictionaryOfPreferencesIn: [ :dictionaryOfPreferences |
+ dictionaryOfPreferences deepCopy ])!
- self  setParameter:#PersonalDictionaryOfPreferences
- to:self dictionaryOfPreferences deepCopy!

Item was changed:
  ----- Method: Preferences class>>storePreferencesIn: (in category 'personalization') -----
  storePreferencesIn: aFileName
  | stream prefsSnapshot |
  #(#Prevailing #PersonalPreferences )  do:[:ea | Parameters  removeKey:ea  ifAbsent:[]].
  stream := ReferenceStream fileNamed: aFileName.
  stream  nextPut:Parameters.
+ prefsSnapshot := self accessDictionaryOfPreferencesIn: [ :dictionaryOfPreferences |
+ dictionaryOfPreferences copy ].
- prefsSnapshot := self dictionaryOfPreferences copy.
  prefsSnapshot keysAndValuesDo: [:key :pref | prefsSnapshot at: key put: pref asPreference].
  stream  nextPut: prefsSnapshot.
  Smalltalk isMorphic
  ifTrue:[stream nextPut:World fillStyle]
  ifFalse:[stream nextPut:DesktopColor].
  stream close!