[squeak-dev] The Trunk: System-eem.745.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Jul 1 19:12:42 UTC 2015
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!
More information about the Squeak-dev
mailing list
|