'From Squeak3.7 of ''4 September 2004'' [latest update: #5989] on 26 September 2004 at 5:42:07 pm'! "Change Set: PrefViewsRegistry-hpt Date: 26 September 2004 Author: Hernan Tylim This changeset is an extension of PrevViews-hpt.cs. What it does is adds a registry mechanism for PreferenceViews allowing in that way distinct implementations of PreferenceBrowser to coexist in the same image."! Object subclass: #Preference instanceVariableNames: 'name value defaultValue helpString localToProject categoryList changeInformee changeSelector viewClass viewRegistry ' classVariableNames: '' poolDictionaries: '' category: 'System-Support'! !Preference commentStamp: '' prior: 0! Represents a true/false flag that is under user control and which can be interrogated by a call to Preferences viewRegistry the registry of the classes responsible for building my view name a symbol, the formal name of the preference. value a boolean, the current value defaultValue the default value of the preference helpString string or text, constituting the help message localToProject boolean, whether each project holds its own version categoryList list of categories under which to offer this changeInformee whom, if anyone, to inform if the value changes: changeSelector what selector to send to the changeInformee when the value changes! PreferenceView class instanceVariableNames: 'registeredClasses '! Object subclass: #PreferenceViewRegistry instanceVariableNames: 'registeredClasses viewOrder' classVariableNames: '' poolDictionaries: '' category: 'System-Support'! !PreferenceViewRegistry commentStamp: '' prior: 0! PreferenceViewRegistry is much like the AppRegistry classes. Its purpose is to allow PreferenceBrowser implementers to register its own views for each kind of preference.! PreferenceViewRegistry class instanceVariableNames: 'registries'! !PreferenceViewRegistry commentStamp: '' prior: 0! PreferenceViewRegistry is much like the AppRegistry classes. Its purpose is to allow PreferenceBrowser implementers to register its own views for each kind of preference.! !Preference methodsFor: 'initialization' stamp: 'hpt 9/26/2004 15:59'! name: aName defaultValue: aValue helpString: aString localToProject: projectBoolean categoryList: aList changeInformee: informee changeSelector: aChangeSelector viewRegistry: aViewRegistry "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. defaultValue := aValue. aValue = #true ifTrue: [defaultValue := true]. aValue = #false ifTrue: [defaultValue := false]. value := defaultValue. helpString := aString. localToProject := projectBoolean == true or: [projectBoolean = #true]. viewRegistry := aViewRegistry. categoryList := (aList ifNil: [OrderedCollection with: #unclassified]) collect: [:elem | elem asSymbol]. changeInformee := (informee == nil or: [informee == #nil]) ifTrue: [nil] ifFalse: [(informee isKindOf: Symbol) ifTrue: [Smalltalk at: informee] ifFalse: [informee]]. changeSelector := aChangeSelector! ! !Preference methodsFor: 'value' stamp: 'hpt 9/26/2004 16:51'! togglePreferenceValue "Toggle whether the value of the preference. Self must be a boolean preference." value := value not. self notifyInformeeOfChange! ! !Preference methodsFor: 'user interface' stamp: 'hpt 9/26/2004 16:58'! representativeButtonWithColor: aColor inPanel: aPanel | view | view _ self viewForPanel: aPanel. ^view ifNotNil: [view representativeButtonWithColor: aColor inPanel: aPanel]! ! !Preference methodsFor: 'user interface' stamp: 'hpt 9/26/2004 15:42'! viewClassForPanel: aPreferencePanel ^self viewRegistry viewClassFor: aPreferencePanel! ! !Preference methodsFor: 'user interface' stamp: 'hpt 9/26/2004 16:58'! viewForPanel: aPreferencePanel | viewClass | viewClass _ self viewClassForPanel: aPreferencePanel. ^viewClass ifNotNil: [viewClass preference: self]! ! !Preference methodsFor: 'user interface' stamp: 'hpt 9/26/2004 15:40'! viewRegistry ^viewRegistry! ! !Preference methodsFor: 'user interface' stamp: 'hpt 9/26/2004 15:40'! viewRegistry: aRegistry viewRegistry _ aRegistry! ! !PreferenceView methodsFor: 'user interface' stamp: 'hpt 9/26/2004 16:14'! tearOffButton "Hand the user a button the can control this" | aButton | aButton := self representativeButtonWithColor: self preference defaultBackgroundColor inPanel: nil. aButton borderWidth: 1; borderColor: Color black; useRoundedCorners. aButton openInHand! ! !PreferenceView class methodsFor: 'view registry' stamp: 'hpt 9/26/2004 16:09'! handlesPanel: aPreferencePanel self subclassResponsibility ! ! !BooleanPreferenceView class methodsFor: 'class initialization' stamp: 'hpt 9/26/2004 15:55'! initialize PreferenceViewRegistry ofBooleanPreferences register: self.! ! !BooleanPreferenceView class methodsFor: 'class initialization' stamp: 'hpt 9/26/2004 15:55'! unload PreferenceViewRegistry ofBooleanPreferences unregister: self.! ! !BooleanPreferenceView class methodsFor: 'view registry' stamp: 'hpt 9/26/2004 16:10'! handlesPanel: aPreferencePanel ^aPreferencePanel isKindOf: PreferencesPanel! ! !HaloThemePreferenceView class methodsFor: 'class initialization' stamp: 'hpt 9/26/2004 15:58'! initialize "adding the halo theme preference to Preferences and registering myself as its view" PreferenceViewRegistry ofHaloThemePreferences register: self. Preferences addPreference: #haloTheme categories: {#halos} default: #iconicHaloSpecifications balloonHelp: '' projectLocal: false changeInformee: nil changeSelector: nil viewRegistry: PreferenceViewRegistry ofHaloThemePreferences.! ! !HaloThemePreferenceView class methodsFor: 'class initialization' stamp: 'hpt 9/26/2004 15:58'! unload PreferenceViewRegistry ofHaloThemePreferences unregister: self.! ! !HaloThemePreferenceView class methodsFor: 'view registry' stamp: 'hpt 9/26/2004 16:10'! handlesPanel: aPreferencePanel ^aPreferencePanel isKindOf: PreferencesPanel! ! !PreferenceViewRegistry methodsFor: 'view registry' stamp: 'hpt 9/26/2004 15:26'! register: aProviderClass (self registeredClasses includes: aProviderClass) ifFalse: [self registeredClasses add: aProviderClass].! ! !PreferenceViewRegistry methodsFor: 'view registry' stamp: 'hpt 9/26/2004 15:26'! registeredClasses ^registeredClasses ifNil: [registeredClasses := OrderedCollection new]! ! !PreferenceViewRegistry methodsFor: 'view registry' stamp: 'hpt 9/26/2004 15:26'! unregister: aProviderClass self registeredClasses remove: aProviderClass ifAbsent: []! ! !PreferenceViewRegistry methodsFor: 'view registry' stamp: 'hpt 9/26/2004 15:26'! viewClassFor: aPreferencePanel ^self registeredClasses detect: [:aViewClass| aViewClass handlesPanel: aPreferencePanel] ifNone: [].! ! !PreferenceViewRegistry methodsFor: 'view order' stamp: 'hpt 9/26/2004 16:22'! viewOrder "answer the order in which the registered views should appear relative to the other views" ^viewOrder! ! !PreferenceViewRegistry methodsFor: 'view order' stamp: 'hpt 9/26/2004 16:22'! viewOrder: aNumber viewOrder _ aNumber! ! !PreferenceViewRegistry methodsFor: 'initialize-release' stamp: 'hpt 9/26/2004 16:22'! initialize viewOrder _ 1.! ! !PreferenceViewRegistry class methodsFor: 'instance creation' stamp: 'hpt 9/26/2004 16:23'! ofBooleanPreferences ^(self registryOf: #booleanPreferences) viewOrder: 1; yourself.! ! !PreferenceViewRegistry class methodsFor: 'instance creation' stamp: 'hpt 9/26/2004 16:24'! ofColorPreferences ^(self registryOf: #colorPreferences) viewOrder: 5; yourself.! ! !PreferenceViewRegistry class methodsFor: 'instance creation' stamp: 'hpt 9/26/2004 16:24'! ofFontPreferences ^(self registryOf: #fontPreferences) viewOrder: 4; yourself.! ! !PreferenceViewRegistry class methodsFor: 'instance creation' stamp: 'hpt 9/26/2004 16:23'! ofHaloThemePreferences ^(self registryOf: #haloThemePreferences) viewOrder: 2; yourself.! ! !PreferenceViewRegistry class methodsFor: 'instance creation' stamp: 'hpt 9/26/2004 16:23'! ofTextPreferences ^(self registryOf: #textPreferences) viewOrder: 3; yourself.! ! !PreferenceViewRegistry class methodsFor: 'instance creation' stamp: 'hpt 9/26/2004 15:28'! registries ^registries ifNil: [registries _ Dictionary new]! ! !PreferenceViewRegistry class methodsFor: 'instance creation' stamp: 'hpt 9/26/2004 15:33'! registryOf: aSymbol ^self registries at: aSymbol ifAbsentPut: [self new]! ! !Preferences class methodsFor: 'add preferences' stamp: 'hpt 9/26/2004 16:00'! addBooleanPreference: prefSymbol categories: categoryList default: defaultValue balloonHelp: helpString "Add an item repreesenting the given preference symbol to the system. Default view for this preference is boolean to keep backward compatibility" self addPreference: prefSymbol categories: categoryList default: defaultValue balloonHelp: helpString projectLocal: false changeInformee: nil changeSelector: nil viewRegistry: PreferenceViewRegistry ofBooleanPreferences ! ! !Preferences class methodsFor: 'add preferences' stamp: 'hpt 9/26/2004 16:01'! addBooleanPreference: prefSymbol category: categorySymbol default: defaultValue balloonHelp: helpString "Add an item repreesenting the given preference symbol to the system. Default view for this preference is boolean to keep backward compatibility" self addPreference: prefSymbol categories: {categorySymbol} default: defaultValue balloonHelp: helpString projectLocal: false changeInformee: nil changeSelector: nil viewRegistry: PreferenceViewRegistry ofBooleanPreferences ! ! !Preferences class methodsFor: 'add preferences' stamp: 'hpt 9/26/2004 16:03'! addColorPreference: prefSymbol categories: categoryList default: defaultValue balloonHelp: helpString "Add an item repreesenting the given preference symbol to the system. Default view for this preference is boolean to keep backward compatibility" self addPreference: prefSymbol categories: categoryList default: defaultValue balloonHelp: helpString projectLocal: false changeInformee: nil changeSelector: nil viewRegistry: PreferenceViewRegistry ofColorPreferences ! ! !Preferences class methodsFor: 'add preferences' stamp: 'hpt 9/26/2004 16:03'! addColorPreference: prefSymbol category: categorySymbol default: defaultValue balloonHelp: helpString "Add an item repreesenting the given preference symbol to the system. Default view for this preference is boolean to keep backward compatibility" self addPreference: prefSymbol categories: {categorySymbol} default: defaultValue balloonHelp: helpString projectLocal: false changeInformee: nil changeSelector: nil viewRegistry: PreferenceViewRegistry ofColorPreferences ! ! !Preferences class methodsFor: 'add preferences' stamp: 'hpt 9/26/2004 16:03'! addFontPreference: prefSymbol categories: categoryList default: defaultValue balloonHelp: helpString "Add an item repreesenting the given preference symbol to the system. Default view for this preference is boolean to keep backward compatibility" self addPreference: prefSymbol categories: categoryList default: defaultValue balloonHelp: helpString projectLocal: false changeInformee: nil changeSelector: nil viewRegistry: PreferenceViewRegistry ofFontPreferences ! ! !Preferences class methodsFor: 'add preferences' stamp: 'hpt 9/26/2004 16:02'! addFontPreference: prefSymbol category: categorySymbol default: defaultValue balloonHelp: helpString "Add an item repreesenting the given preference symbol to the system. Default view for this preference is boolean to keep backward compatibility" self addPreference: prefSymbol categories: {categorySymbol} default: defaultValue balloonHelp: helpString projectLocal: false changeInformee: nil changeSelector: nil viewRegistry: PreferenceViewRegistry ofFontPreferences ! ! !Preferences class methodsFor: 'add preferences' stamp: 'hpt 9/26/2004 16:05'! addPreference: prefSymbol categories: categoryList default: defaultValue balloonHelp: helpString "Add an item repreesenting the given preference symbol to the system. Default view for this preference is boolean to keep backward compatibility" self addBooleanPreference: prefSymbol categories: categoryList default: defaultValue balloonHelp: helpString.! ! !Preferences class methodsFor: 'add preferences' stamp: 'hpt 9/26/2004 17:41'! addPreference: prefSymbol categories: categoryList default: aValue balloonHelp: helpString projectLocal: localBoolean changeInformee: informeeSymbol changeSelector: aChangeSelector viewRegistry: aViewRegistry "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." | aPreference | aPreference := DictionaryOfPreferences at: prefSymbol ifAbsent: [Preference new]. aPreference name: prefSymbol defaultValue: aValue helpString: helpString localToProject: localBoolean categoryList: categoryList changeInformee: informeeSymbol changeSelector: aChangeSelector viewRegistry: aViewRegistry. DictionaryOfPreferences at: prefSymbol put: aPreference. self compileAccessMethodForPreference: aPreference! ! !Preferences class methodsFor: 'add preferences' stamp: 'hpt 9/26/2004 16:05'! addPreference: prefSymbol category: categorySymbol default: defaultValue balloonHelp: helpString "Add the given preference, putting it in the given category, with the given default value, and with the given balloon help. It assumes boolean preference for backward compatibility" self addBooleanPreference: prefSymbol category: categorySymbol default: defaultValue balloonHelp: helpString.! ! !Preferences class methodsFor: 'add preferences' stamp: 'hpt 9/26/2004 16:02'! addTextPreference: prefSymbol categories: categoryList default: defaultValue balloonHelp: helpString "Add an item repreesenting the given preference symbol to the system. Default view for this preference is boolean to keep backward compatibility" self addPreference: prefSymbol categories: categoryList default: defaultValue balloonHelp: helpString projectLocal: false changeInformee: nil changeSelector: nil viewRegistry: PreferenceViewRegistry ofTextPreferences ! ! !Preferences class methodsFor: 'add preferences' stamp: 'hpt 9/26/2004 16:02'! addTextPreference: prefSymbol category: categorySymbol default: defaultValue balloonHelp: helpString "Add an item repreesenting the given preference symbol to the system. Default view for this preference is boolean to keep backward compatibility" self addPreference: prefSymbol categories: {categorySymbol} default: defaultValue balloonHelp: helpString projectLocal: false changeInformee: nil changeSelector: nil viewRegistry: PreferenceViewRegistry ofTextPreferences ! ! !Preferences class methodsFor: 'get/set' stamp: 'hpt 9/26/2004 16:50'! togglePreference: prefSymbol "Toggle the given preference. prefSymbol must be of a boolean preference" (self preferenceAt: prefSymbol ifAbsent: [self error: 'unknown preference: ', prefSymbol]) togglePreferenceValue! ! !Preferences class methodsFor: 'get/set' stamp: 'hpt 9/26/2004 16:49'! valueOfPreference: aPreferenceSymbol ifAbsent: booleanValuedBlock "Answer the value of the given preference" ^ (self preferenceAt: aPreferenceSymbol ifAbsent: [^ booleanValuedBlock value]) preferenceValue! ! !Preferences class methodsFor: 'get/set' stamp: 'hpt 9/26/2004 16:49'! valueOfFlag: aFlagName "Utility method for all the preferences that are boolean, and for backward compatibility" ^self valueOfPreference: aFlagName ifAbsent: [false].! ! !Preferences class methodsFor: 'get/set' stamp: 'hpt 9/26/2004 16:48'! valueOfFlag: aFlagName ifAbsent: booleanValuedBlock "the same as in #valueOfFlag:" ^self valueOfPreference: aFlagName ifAbsent: booleanValuedBlock.! ! !Preferences class methodsFor: 'get/set' stamp: 'hpt 9/26/2004 16:49'! valueOfPreference: aPreferenceSymbol "Answer the value of the given preference" ^self valueOfPreference: aPreferenceSymbol ifAbsent: []! ! !Preferences class methodsFor: 'preferences panel' stamp: 'hpt 9/26/2004 16:54'! initializePreferencePanel: aPanel in: aPasteUpMorph "Initialize the given Preferences panel. in the given pasteup, which is the top-level panel installed in the container window. Also used to reset it after some change requires reformulation" | tabbedPalette controlPage aColor aFont maxEntriesPerCategory tabsMorph anExtent prefObjects cc | aPasteUpMorph removeAllMorphs. aFont := StrikeFont familyName: 'NewYork' size: 19. aColor := aPanel defaultBackgroundColor. tabbedPalette := TabbedPalette newSticky. tabbedPalette dropEnabled: false. (tabsMorph := tabbedPalette tabsMorph) color: aColor darker; highlightColor: Color red regularColor: Color brown darker darker. tabbedPalette on: #mouseDown send: #yourself to: #(). maxEntriesPerCategory := 0. self listOfCategories do: [:aCat | controlPage := AlignmentMorph newColumn beSticky color: aColor. controlPage on: #mouseDown send: #yourself to: #(). controlPage dropEnabled: false. Preferences alternativeWindowLook ifTrue: [cc := Color transparent. controlPage color: cc]. controlPage borderColor: aColor; layoutInset: 4. (prefObjects := self preferenceObjectsInCategory: aCat) do: [:aPreference | | button | button _ aPreference representativeButtonWithColor: cc inPanel: aPanel. button ifNotNil: [controlPage addMorphBack: button]]. controlPage setNameTo: aCat asString. aCat = #? ifTrue: [aPanel addHelpItemsTo: controlPage]. tabbedPalette addTabFor: controlPage font: aFont. aCat = 'search results' ifTrue: [(tabbedPalette tabNamed: aCat) setBalloonText: 'Use the ? category to find preferences by keyword; the results of your search will show up here']. maxEntriesPerCategory := maxEntriesPerCategory max: prefObjects size]. tabbedPalette selectTabNamed: '?'. tabsMorph rowsNoWiderThan: aPasteUpMorph width. aPasteUpMorph on: #mouseDown send: #yourself to: #(). anExtent := aPasteUpMorph width @ (490 max: (25 + tabsMorph height + (20 * maxEntriesPerCategory))). aPasteUpMorph extent: anExtent. aPasteUpMorph color: aColor. aPasteUpMorph addMorphBack: tabbedPalette.! ! !Preferences class methodsFor: 'preferences panel' stamp: 'hpt 9/26/2004 15:54'! preferenceObjectsInCategory: aCategorySymbol "Answer a list of Preference objects that reside in the given category, in alphabetical order" ^ (DictionaryOfPreferences select: [:aPreference | aPreference categoryList includes: aCategorySymbol]) asSortedCollection: [:pref1 :pref2 | (pref1 viewRegistry viewOrder < pref2 viewRegistry viewOrder) or: [(pref1 viewRegistry viewOrder = pref2 viewRegistry viewOrder) & (pref1 name < pref2 name)]]! ! !PreferencesPanel methodsFor: 'initialization' stamp: 'hpt 9/26/2004 16:55'! findPreferencesMatching: incomingTextOrString "find all preferences matching incomingTextOrString" | result aList aPalette controlPage cc | result := incomingTextOrString asString asLowercase. result := result asLowercase withBlanksTrimmed. result isEmptyOrNil ifTrue: [^ self]. aList := Preferences allPreferenceObjects select: [:aPreference | (aPreference name includesSubstring: result caseSensitive: false) or: [aPreference helpString includesSubstring: result caseSensitive: false]]. aPalette := (self containingWindow ifNil: [^ self]) findDeeplyA: TabbedPalette. aPalette ifNil: [^ self]. aPalette selectTabNamed: 'search results'. aPalette currentPage ifNil: [^ self]. "bkwd compat" controlPage := aPalette currentPage. controlPage removeAllMorphs. controlPage addMorph: (StringMorph contents: ('Preferences matching "', self searchString, '"') font: Preferences standardButtonFont). Preferences alternativeWindowLook ifTrue:[ cc := Color transparent. controlPage color: cc]. aList := aList asSortedCollection: [:a :b | a name < b name]. aList do: [:aPreference | | button | button _ aPreference representativeButtonWithColor: cc inPanel: self. button ifNotNil: [controlPage addMorphBack: button]]. aPalette world startSteppingSubmorphsOf: aPalette! ! Preferences class removeSelector: #addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector:viewClass:! !PreferenceViewRegistry class reorganize! ('instance creation' ofBooleanPreferences ofColorPreferences ofFontPreferences ofHaloThemePreferences ofTextPreferences registries registryOf:) ! !PreferenceViewRegistry reorganize! ('view registry' register: registeredClasses unregister: viewClassFor:) ('view order' viewOrder viewOrder:) ('initialize-release' initialize) ! HaloThemePreferenceView initialize! HaloThemePreferenceView class removeSelector: #viewOrder! !HaloThemePreferenceView class reorganize! ('class initialization' initialize unload) ('view registry' handlesPanel:) ! BooleanPreferenceView initialize! BooleanPreferenceView class removeSelector: #viewOrder! !BooleanPreferenceView class reorganize! ('class initialization' initialize unload) ('view registry' handlesPanel:) ! PreferenceView class removeSelector: #register:! PreferenceView class removeSelector: #registeredClasses! PreferenceView class removeSelector: #unregister:! PreferenceView class removeSelector: #viewClassFor:! PreferenceView class removeSelector: #viewOrder! PreferenceView class instanceVariableNames: 'registeredClasses'! !PreferenceView class reorganize! ('instance creation' preference:) ('view registry' handlesPanel:) ! Preference removeSelector: #name:defaultValue:helpString:localToProject:categoryList:changeInformee:changeSelector:viewClass:! Preference removeSelector: #view! Preference removeSelector: #viewClass! Preference removeSelector: #viewClass:! Object subclass: #Preference instanceVariableNames: 'name value defaultValue helpString localToProject categoryList changeInformee changeSelector viewRegistry' classVariableNames: '' poolDictionaries: '' category: 'System-Support'! "Postscript: Adds the registries to the existing Preference instances on the image" PreferenceViewRegistry ofBooleanPreferences register: BooleanPreferenceView. PreferenceViewRegistry ofHaloThemePreferences register: HaloThemePreferenceView. Preference allInstances do: [:ea | ea name == #haloTheme ifTrue: [ea viewRegistry: PreferenceViewRegistry ofHaloThemePreferences] ifFalse: [ea viewRegistry: PreferenceViewRegistry ofBooleanPreferences]]. !