[squeak-dev] Squeak 4.6: System-ul.748.mczcommits at source.squeak.org commits at source.squeak.orgWed Jul 1 19:35:51 UTC 2015
Chris Muller uploaded a new version of System to project Squeak 4.6: http://source.squeak.org/squeak46/System-ul.748.mcz ==================== Summary ==================== Name: System-ul.748 Author: ul Time: 1 July 2015, 1:17:39.216 pm UUID: 7e127e9c-33da-4199-b81f-324808eebfae Ancestors: System-eem.747 - Iterate over pragmas once per method instead of once per pragma in Preferences class>>prefEvent:. - There's no need to copy preferencesDictionary in Preferences class>>storePreferencesIn:, because it's a read-only data structure. - Ensure the durability of the changes of preferencesDictionary in Preferences class>>atomicUpdatePreferences: by checking for changes before overwriting it. =============== Diff against System-topa.743 =============== 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 class + instanceVariableNames: 'preferencesDictionary'! + !Preferences commentStamp: 'eem 6/30/2015 15:10' 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 answered as false. - !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: + PreferenceBrowser open - 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. There are two kinds of preference definition, preference pragmas (which are preferred) and preferences local to Preferences. - All messages are on the class side. + Preference Pragmas + Preferences can be local to a class or system of classes using preference pragmas. Look at senders of #preference:category:description:type: and #preference:categoryList:description:type: for examples: + (self systemNavigation browseAllSelect: + [:m| + #(preference:category:description:type: preference:categoryList:description:type:) anySatisfy: + [:s| (m pragmaAt: s) notNil]]) + With a preference pragma, the preference is typically kept in a class variable, local to the class whose method(s) contain(s) the pragma. Good style is to put the preference pragma in the accessor for the variable; see for example BitBlt class>>#subPixelRenderColorFonts. The pragma serves to declare the preference to Preferences. + + + Preference-local Preferences 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, either as as illustrated below, or by using - 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 non-pragma 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 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. ! + Preferences class + instanceVariableNames: 'preferencesDictionary'! 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 := preferencesDictionary + 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" + ^preferencesDictionary 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." + + [ + | originalPreferences copyOfPreferences | + originalPreferences := preferencesDictionary. + copyOfPreferences := preferencesDictionary + ifNil: [ IdentityDictionary new ] + ifNotNil: [ :dictionary | dictionary copy ]. + aBlock value: copyOfPreferences. + originalPreferences == preferencesDictionary ifTrue: [ + preferencesDictionary := copyOfPreferences. + ^self ] ] repeat! 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>>dictionaryOfPreferences (in category 'accessing') ----- dictionaryOfPreferences + "N.B. Does /not/ answer the dictionary itself. To burrow that deep use e.g. instVarNamed:" + ^preferencesDictionary copy! - "The use of this accessor doesn't ensure that the dictionary is not accessed concurrently. Use #accessDictionaryOfPreferencesIn: instead." - - ^DictionaryOfPreferences! Item was removed: - ----- Method: Preferences class>>dictionaryOfPreferences: (in category 'accessing') ----- - dictionaryOfPreferences: anObject - DictionaryOfPreferences := anObject! Item was changed: ----- Method: Preferences class>>initializeDictionaryOfPreferences (in category 'initialization') ----- initializeDictionaryOfPreferences + "Initialize the preferencesDictionary to be an empty IdentityDictionary" - "Initialize the DictionaryOfPreferences to be an empty IdentityDictionary" "Preferences initializeDictionaryOfPreferences" + preferencesDictionary := IdentityDictionary new! - self dictionaryOfPreferences:IdentityDictionary new! 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." "Preferences inspectPreferences" + preferencesDictionary 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 | + 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: + [self respondToPreferencePragmasInMethod: anEvent item 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" + ^preferencesDictionary 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: preferencesDictionary deepCopy! - setParameter:#PersonalDictionaryOfPreferences - to: ( - self accessDictionaryOfPreferencesIn: [ :dictionaryOfPreferences | - dictionaryOfPreferences deepCopy ])! Item was changed: ----- Method: Preferences class>>storePreferencesIn: (in category 'personalization') ----- + storePreferencesIn: aFileName + + | stream | + #(Prevailing PersonalPreferences) do: + [:ea | + Parameters removeKey: ea ifAbsent: []]. - storePreferencesIn: aFileName - | stream prefsSnapshot | - #(#Prevailing #PersonalPreferences ) do:[:ea | Parameters removeKey:ea ifAbsent:[]]. stream := ReferenceStream fileNamed: aFileName. + stream nextPut: Parameters. + preferencesDictionary keysAndValuesDo: [:key :pref | preferencesDictionary at: key put: pref asPreference]. + stream nextPut: preferencesDictionary. + stream nextPut: (Smalltalk isMorphic + ifTrue:[World fillStyle] + ifFalse:[DesktopColor]). - stream nextPut:Parameters. - prefsSnapshot := self accessDictionaryOfPreferencesIn: [ :dictionaryOfPreferences | - 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! Item was changed: ----- Method: SmalltalkImage>>license (in category 'license') ----- license "This method contains the text of the license agreement for Squeak." ^ + 'Copyright (c) The individual, corporate, and institutional contributors who have collectively contributed elements to this software ("The Squeak Community"), 1996-2015 All rights reserved. - 'Copyright (c) The individual, corporate, and institutional contributors who have collectively contributed elements to this software ("The Squeak Community"), 1996-2014 All rights reserved. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. Portions of Squeak are covered by the following license Copyright (c) Xerox Corp. 1981, 1982 All rights reserved. Copyright (c) Apple Computer, Inc. 1985-1996 All rights reserved. Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. '! Item was changed: (PackageInfo named: 'System') postscript: '" Convert SoundService registeredClasses to classes if necessary " [ | currentSoundSystem | currentSoundSystem := SoundService defaultOrNil. (SoundService registeredClasses copy collect: [:ss | SoundService unregister: ss. ss isBehavior ifTrue: [ss] ifFalse: [ss class]] ) do: [:ssClass | SoundService register: ssClass]. SoundService default: (currentSoundSystem ifNotNil: [:css| css isBehavior ifTrue: [css] ifFalse: [css class]]). + ] value. + + "Convert preferences dictionary from class var to inst var if necessary." + (Preferences instVarNamed: ''preferencesDictionary'') ifNil: + [(Preferences classPool at: #DictionaryOfPreferences) ifNotNil: + [:dictionary| + Preferences + instVarNamed: ''preferencesDictionary'' + put: dictionary]]. + + (Smalltalk classNamed: #ServicePreferences) ifNotNil: + [:sp| + (sp instVarNamed: ''preferencesDictionary'') ifNil: + [(sp classPool at: #ServiceDictionaryOfPreferences) ifNotNil: + [:dictionary| + sp + instVarNamed: ''preferencesDictionary'' + put: dictionary]]]'! - ] value'!
More information about the Squeak-dev mailing list |