[Pkg] 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 Packages mailing list