The Trunk: System-eem.745.mcz

Chris Muller uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-eem.745.mcz

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

Name: System-eem.745
Author: eem
Time: 30 June 2015, 1:54:22.14 pm
UUID: 6af94be8-f437-435f-a94b-811c5de2938a
Ancestors: System-cmm.744

Rewrite Preferences to eliminate the AccessProtect.
Use a copy, update copy, assign scheme to update
the preferences dictionary atomically.

Change Preferences access method compilation to
use Object>>#value to eliminate a block creation.

Change Preference initialization to eliminate the
isKindOf: Symbol.

This is step 1.  Given SystemPreferences it is clear
that the preferences dictionary should be stored in
a class inst var, so that SystemPreferences and
Preferences can share methods but access different
dictionaries.  The dictionaryOfProferences[:] accessors
are dubious as they break encapsulatiopn.  For example,
the reportPreferences: method, which is the only external
access, could insateaqd be moved into Preferences class.

=============== Diff against System-cmm.744 ===============

Item was changed:
  ----- Method: Preference>>name:defaultValue:helpString:localToProject:categoryList:changeInformee:changeSelector:type: (in category 'initialization') -----
  name: aName defaultValue: aValue helpString: aString localToProject: projectBoolean categoryList: aList changeInformee: informee changeSelector:  aChangeSelector type: aType
  "Initialize the preference from the given values.  There is an extra tolerence here for the symbols #true, #false, and #nil, which are interpreted, when appropriate, as meaning true, false, and nil"
 
  name := aName asSymbol.
+ value := defaultValue := aValue
+ caseOf: {
+ [#true] -> [true].
+ [#false] -> [false] }
+ otherwise:
+ [aValue].
- defaultValue := aValue.
- aValue = #true ifTrue: [defaultValue := true].
- aValue = #false ifTrue: [defaultValue := false].
- value := defaultValue.
  helpString := aString.
  localToProject := projectBoolean == true or: [projectBoolean = #true].
  type := aType.
+ categoryList := aList
+ ifNil: [OrderedCollection with: #unclassified]
+ ifNotNil: [aList collect: [:elem | elem asSymbol]].
- categoryList := (aList ifNil: [OrderedCollection with: #unclassified]) collect:
- [:elem | elem asSymbol].
 
+ changeInformee := (informee == nil or: [informee == #nil]) ifFalse:
+ [(informee isSymbol)
+ ifTrue: [Smalltalk at: informee]
+ ifFalse: [informee]].
- changeInformee := (informee == nil or: [informee == #nil])
- ifTrue: [nil]
- ifFalse: [(informee isKindOf: Symbol)
- ifTrue:
- [Smalltalk at: informee]
- ifFalse:
- [informee]].
  changeSelector  := aChangeSelector!

Item was changed:
  Object subclass: #Preferences
  instanceVariableNames: ''
+ classVariableNames: 'DesktopColor DictionaryOfPreferences Parameters'
- classVariableNames: 'AccessLock 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 removed:
- ----- 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."
 
+ | newPreference aPreference |
+ (newPreference := Preference new)
+ name: aName asSymbol
+ defaultValue: aValue
+ helpString: helpString
+ localToProject: localBoolean
+ categoryList: categoryList
+ changeInformee: informeeSymbol
+ changeSelector: aChangeSelector
- | aPreference aPrefSymbol |
- aPrefSymbol := aName asSymbol.
- aPreference := self accessDictionaryOfPreferencesIn: [ :dictionaryOfPreferences |
- dictionaryOfPreferences
- at:aPrefSymbol
- ifAbsent: [ Preference new ] ].
- aPreference
- name:aPrefSymbol
- defaultValue:aValue
- helpString:helpString
- localToProject:localBoolean
- categoryList:categoryList
- changeInformee:informeeSymbol
- changeSelector:aChangeSelector
  type: aType.
+ aPreference := DictionaryOfPreferences
+ at: newPreference name
+ ifAbsent: [newPreference].
+ aPreference == newPreference
+ ifTrue: "Atomically add the new preference to the dictionary."
+ [self atomicUpdatePreferences:
+ [:preferenceDictionaryCopy|
+ preferenceDictionaryCopy at: newPreference name put: newPreference]]
+ ifFalse: "Use the copyFrom: primitive to atomically update the existing preference."
+ [aPreference copyFrom: newPreference].
+ self compileAccessMethodForPreference: aPreference!
- self accessDictionaryOfPreferencesIn: [ :dictionaryOfPreferences |
- 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"
 
+ ^DictionaryOfPreferences values!
- ^self accessDictionaryOfPreferencesIn: [ :dictionaryOfPreferences |
- dictionaryOfPreferences values ]!

Item was added:
+ ----- Method: Preferences class>>atomicUpdatePreferences: (in category 'accessing') -----
+ atomicUpdatePreferences: aBlock
+ "Evaluate aBlock with a copy of the preferences dictionary and
+ then assign (assignment is atomic) the copy to the dictionary."
+ | copyOfDictionaryOfPreferences |
+ copyOfDictionaryOfPreferences := DictionaryOfPreferences
+ ifNil: [IdentityDictionary new]
+ ifNotNil: [:dict| dict copy].
+ aBlock value: copyOfDictionaryOfPreferences.
+ DictionaryOfPreferences := copyOfDictionaryOfPreferences!

Item was changed:
  ----- Method: Preferences class>>compileAccessMethodForPreference: (in category 'initialization') -----
  compileAccessMethodForPreference: aPreference
  "Compile an accessor method for the given preference"
 
  self class
  compileSilently: (
+ '{1} ^self valueOfFlag: {2} ifAbsent: {3}'
- '{1} ^self valueOfFlag: {2} ifAbsent: [ {3} ]'
  format: {
  aPreference name asString.
  aPreference name asSymbol printString.
  aPreference defaultValue storeString })
  classified: '*autogenerated - standard queries'!

Item was added:
+ ----- Method: Preferences class>>createPreference:categoryList:description:type: (in category 'private') -----
+ createPreference: prefName categoryList: arrayOfStrings description: helpString type: typeSymbol
+ "Add a preference residing in aMethod"
+ |  aPreference |
+ aPreference := PragmaPreference new.
+ aPreference
+ name: prefName
+ defaultValue: nil "always nil"
+ helpString: helpString
+ localToProject: false "governed by the method"
+ categoryList: arrayOfStrings
+ changeInformee: nil
+ changeSelector: nil
+ type: typeSymbol.
+ ^aPreference!

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 method |
+ anEvent itemKind = SystemChangeNotifier classKind ifTrue:
+ [^anEvent isRemoved ifTrue:
+ [self removePreferencesFor: anEvent item]].
+ (anEvent itemKind = SystemChangeNotifier methodKind
+ and: [(aClass := anEvent itemClass) isMeta]) ifFalse: "ignore instance methods"
+ [^self].
+ aClass := aClass theNonMetaClass.
+ aSelector := anEvent itemSelector.
+ anEvent isRemoved
+ ifTrue:
+ [self atomicUpdatePreferences: [ :copyOfDictionaryOfPreferences |
+ copyOfDictionaryOfPreferences removeKey: (aClass name,'>>', aSelector) asSymbol ifAbsent: []]]
+ ifFalse:
+ [(anEvent isAdded or: [anEvent isModified]) ifTrue:
+ [method := anEvent item.
+ method pragmas do:
+ [:pragma|
+ self respondToPreferencePragmasInMethod: method class: aClass]]]!
- | 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:[] ] ].
- (anEvent isAdded or:[anEvent isModified]) ifTrue:[
- method := anEvent item.
- method pragmas do:[:pragma| | aPreference aPrefSymbol |
- ((pragma keyword == #preference:category:description:type:)
- or: [pragma keyword == #preference:categoryList: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 ] ] ] ] ].
- !

Item was changed:
  ----- Method: Preferences class>>preference:category:description:type: (in category 'dynamic preferences') -----
+ preference: prefName category: categoryName description: helpString type: typeSymbol
+ "Create a preference for a preference pragma in a method.
+ This method gets invoked from respondToPreferencePragmasInMethod:class:"
+ ^self createPreference: prefName
+ categoryList: (categoryName isArray "Alas pragma users are not always careful"
+ ifTrue: [categoryName]
+ ifFalse: [{categoryName} asArray])
+ description: helpString
+ type: typeSymbol!
- preference: prefName category: aStringOrArrayOfStrings description: helpString type: typeSymbol
- "Add a preference residing in aMethod"
- |  aPreference |
- aPreference := PragmaPreference new.
- aPreference
- name: prefName
- defaultValue: nil "always nil"
- helpString: helpString
- localToProject: false "governed by the method"
- categoryList: (aStringOrArrayOfStrings isArray ifTrue:[aStringOrArrayOfStrings] ifFalse:[{aStringOrArrayOfStrings}])
- changeInformee: nil
- changeSelector: nil
- type: typeSymbol.
- ^aPreference!

Item was added:
+ ----- Method: Preferences class>>preference:categoryList:description:type: (in category 'dynamic preferences') -----
+ preference: prefName categoryList: categoryList description: helpString type: typeSymbol
+ "Create a preference for a preference pragma in a method.
+ This method gets invoked from respondToPreferencePragmasInMethod:class:"
+ ^self createPreference: prefName categoryList: categoryList asArray description: helpString type: typeSymbol!

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"
 
+ ^DictionaryOfPreferences at: aSymbol ifAbsent: aBlock!
- self accessDictionaryOfPreferencesIn: [ :dictionaryOfPreferences |
-                 dictionaryOfPreferences
-                         at: aSymbol
-                         ifPresent: [ :preference | ^preference ] ].
-         ^aBlock value!

Item was changed:
  ----- Method: Preferences class>>registerForEvents (in category 'dynamic preferences') -----
  registerForEvents
  "Preferences registerForEvents"
 
+ SystemChangeNotifier uniqueInstance
+ noMoreNotificationsFor: self;
+ notify: self ofAllSystemChangesUsing: #prefEvent:.
+ Smalltalk allClassesDo:
+ [:aClass|
+ aClass class methodsDo:
+ [:method|
+ self respondToPreferencePragmasInMethod: method class: aClass]]!
- 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 ] ] ] ] ].
- !

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 allProjects do:
+ [:proj |
+ proj projectPreferenceFlagDictionary ifNotNil:
+ [:projectpreferences|
+ projectpreferences removeKey:aSymbol  ifAbsent:[]]]].
+ self atomicUpdatePreferences: [ :copyOfDictionaryOfPreferences |
+ copyOfDictionaryOfPreferences removeKey: aSymbol ifAbsent: nil ].
+ self class removeSelector: aSymbol
- 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 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 atomicUpdatePreferences:
+ [:copyOfDictionaryOfPreferences| | map |
+ map := copyOfDictionaryOfPreferences select: [ :pref | pref provider == aClass].
+ map keysDo:
+ [ :prefName |
+ copyOfDictionaryOfPreferences removeKey: prefName]]!
- self accessDictionaryOfPreferencesIn: [ :dictionaryOfPreferences |
- | map |
- map := dictionaryOfPreferences select: [ :pref | pref provider == aClass ].
- map keysDo: [ :prefName | dictionaryOfPreferences removeKey: prefName ] ]!

Item was added:
+ ----- Method: Preferences class>>respondToPreferencePragmasInMethod:class: (in category 'dynamic preferences') -----
+ respondToPreferencePragmasInMethod: method class: class
+ method pragmas do:
+ [:pragma| | preference |
+ ((pragma keyword beginsWith: #preference:)
+ and: [self respondsTo: pragma keyword]) ifTrue:
+ [preference := self
+ perform: pragma keyword
+ withArguments: pragma arguments.
+ preference
+ provider: class
+ getter: method selector
+ setter: method selector asMutator.
+ self atomicUpdatePreferences:
+ [ :copyOfDictionaryOfPreferences |
+ copyOfDictionaryOfPreferences
+ at: (class name, '>>', method selector) asSymbol
+ put: preference]]]!

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: DictionaryOfPreferences deepCopy!
- setParameter:#PersonalDictionaryOfPreferences
- to: (
- self accessDictionaryOfPreferencesIn: [ :dictionaryOfPreferences |
- dictionaryOfPreferences deepCopy ])!

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