"Change Set: PreferencesNotification-nk Date: 10 February 2001 Author: Ned Konz This provides user-added Preferences settings with an event notification upon changes. If you've added a preference flag called XXX, you can just say: Preferences when: #XXXPreferenceChanged send: #yyy: to: someObject. and someObject will get notified of the new value through a call to its method yyy. This also works for non-flag parameters."! !Preferences class methodsFor: 'parameters' stamp: 'nk 2/10/2001 12:36'! setParameter: paramName to: paramValue "Set the given field in the parameters dictionary." Parameters at: paramName put: paramValue. self trigger: (paramName, #PreferenceChanged) asSymbol with: paramValue! ! !Preferences class methodsFor: 'preferences dictionary' stamp: 'nk 2/10/2001 12:20'! noteThatFlag: prefSymbol justChangedTo: aBoolean "Provides a hook so that a user's toggling of a preference might precipitate some immediate action" | keep | prefSymbol == #useGlobalFlaps ifTrue: [aBoolean ifFalse: "Turning off use of flaps" [keep _ self confirm: 'Do you want to preserve the existing global flaps for future use?'. Utilities globalFlapTabsIfAny do: [:aFlapTab | Utilities removeFlapTab: aFlapTab keepInList: keep. aFlapTab isInWorld ifTrue: [self error: 'Flap problem']]. keep ifFalse: [Utilities clobberFlapTabList]] ifTrue: "Turning on use of flaps" [Smalltalk isMorphic ifTrue: [self currentWorld addGlobalFlaps]]]. prefSymbol == #roundedWindowCorners ifTrue: [Display repaintMorphicDisplay]. prefSymbol == #optionalButtons ifTrue: [Utilities replacePartSatisfying: [:el | (el isKindOf: MorphThumbnail) and: [(el morphRepresented isKindOf: SystemWindow) and: [el morphRepresented model isKindOf: FileList]]] inGlobalFlapSatisfying: [:f1 | f1 wording = 'Tools'] with: FileList openAsMorph applyModelExtent]. (prefSymbol == #optionalButtons or: [prefSymbol == #annotationPanes]) ifTrue: [Utilities replaceBrowserInToolsFlap]. (prefSymbol == #smartUpdating) ifTrue: [SystemWindow allSubInstancesDo: [:aWindow | aWindow amendSteppingStatus]]. (prefSymbol == #eToyFriendly) ifTrue: [ScriptingSystem customizeForEToyUsers: aBoolean]. ((prefSymbol == #infiniteUndo) and: [aBoolean not]) ifTrue: [CommandHistory resetAllHistory]. self trigger: (prefSymbol, #PreferenceChanged) asSymbol with: aBoolean! !