'From Squeak3.7 of ''4 September 2004'' [latest update: #5989] on 25 September 2004 at 6:37:22 pm'! "Change Set: PrefViews Date: 24 September 2004 Author: Hernan Tylim This changeset does a few modifications to all the Preference related classes in order to allow a Preference to have distinct views (that is distinct buttons for distinct Preference panels). Note that this changeset does not introduce new views only provides the classes and the hooks. One relevant and rather a philosophical change that is introduced here is the following: After installing this .cs, Preference instances will not hold anymore boolean only values. Currently non-boolean values are stored on a Parameters dictionary of the Preferences class. I don't know what was the rationale for that. But this .cs will change that. As an example the Halos theme choice will be stored on Preferences as a Preference, not a parameter. The reason for that is to be able to use the Halo Preference as any other preference, which it is after all. "! Object subclass: #Preference instanceVariableNames: 'name value defaultValue helpString localToProject categoryList changeInformee changeSelector viewClass ' 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 viewClass the class responsible for building my representative 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! Object subclass: #PreferenceView instanceVariableNames: 'preference' classVariableNames: '' poolDictionaries: '' category: 'System-Support'! !PreferenceView commentStamp: '' prior: 0! My subclasses instances are responsible for building the visual representation of each kind of preference.! PreferenceView subclass: #BooleanPreferenceView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Support'! !BooleanPreferenceView commentStamp: '' prior: 0! I am responsible for building the visual representation of a preference that accepts true and false values! PreferenceView subclass: #HaloThemePreferenceView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Support'! !HaloThemePreferenceView commentStamp: '' prior: 0! I am responsible for building the view for the preference that choose the halo theme! !Preference methodsFor: 'initialization' stamp: 'hpt 9/25/2004 13:38'! name: aName defaultValue: aValue helpString: aString localToProject: projectBoolean categoryList: aList changeInformee: informee changeSelector: aChangeSelector viewClass: aViewClass "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]. viewClass := aViewClass. 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: 'user interface' stamp: 'hpt 9/25/2004 12:40'! view ^viewClass preference: self! ! !Preference methodsFor: 'user interface' stamp: 'hpt 9/25/2004 16:24'! viewClass ^viewClass! ! !Preference methodsFor: 'user interface' stamp: 'hpt 9/25/2004 12:40'! viewClass: aPreferenceViewClass viewClass := aPreferenceViewClass! ! !PreferenceView methodsFor: 'initialization' stamp: 'hpt 9/24/2004 22:25'! initializeWithPreference: aPreference preference := aPreference! ! !PreferenceView methodsFor: 'accessing' stamp: 'hpt 9/24/2004 22:25'! preference ^preference! ! !PreferenceView methodsFor: 'user interface' stamp: 'hpt 9/24/2004 22:56'! representativeButtonWithColor: aColor inPanel: aPreferencesPanel self subclassResponsibility ! ! !PreferenceView methodsFor: 'user interface' stamp: 'hpt 9/24/2004 22:56'! 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 "(Preferences preferenceAt: #balloonHelpEnabled) view tearOffButton"! ! !BooleanPreferenceView methodsFor: 'user interface' stamp: 'hpt 9/24/2004 22:36'! offerPreferenceNameMenu: aPanel with: ignored1 in: ignored2 "the user clicked on a preference name -- put up a menu" | aMenu | ActiveHand showTemporaryCursor: nil. aMenu := MenuMorph new defaultTarget: self preference. aMenu addTitle: self preference name. (Preferences okayToChangeProjectLocalnessOf: self preference name) ifTrue: [aMenu addUpdating: #isProjectLocalString target: self preference action: #toggleProjectLocalness. aMenu balloonTextForLastItem: 'Some preferences are best applied uniformly to all projects, and others are best set by each individual project. If this item is checked, then this preference will be printed in bold and will have a separate value for each project']. aMenu add: 'browse senders' target: self systemNavigation selector: #browseAllCallsOn: argument: self preference name. aMenu balloonTextForLastItem: 'This will open a method-list browser on all methods that the send the preference "', self preference name, '".'. aMenu add: 'show category...' target: aPanel selector: #findCategoryFromPreference: argument: self preference name. aMenu balloonTextForLastItem: 'Allows you to find out which category, or categories, this preference belongs to.'. Smalltalk isMorphic ifTrue: [aMenu add: 'hand me a button for this preference' target: self selector: #tearOffButton. aMenu balloonTextForLastItem: 'Will give you a button that governs this preference, which you may deposit wherever you wish']. aMenu add: 'copy this name to clipboard' target: self preference selector: #copyName. aMenu balloonTextForLastItem: 'Copy the name of the preference to the text clipboard, so that you can paste into code somewhere'. aMenu popUpInWorld! ! !BooleanPreferenceView methodsFor: 'user interface' stamp: 'hpt 9/24/2004 22:33'! representativeButtonWithColor: aColor inPanel: aPreferencesPanel "Return a button that controls the setting of prefSymbol. It will keep up to date even if the preference value is changed in a different place" | outerButton aButton str miniWrapper | outerButton := AlignmentMorph newRow height: 24. outerButton color: (aColor ifNil: [Color r: 0.645 g: 1.0 b: 1.0]). outerButton hResizing: (aPreferencesPanel ifNil: [#shrinkWrap] ifNotNil: [#spaceFill]). outerButton vResizing: #shrinkWrap. outerButton addMorph: (aButton := UpdatingThreePhaseButtonMorph checkBox). aButton target: self preference; actionSelector: #togglePreferenceValue; getSelector: #preferenceValue. outerButton addTransparentSpacerOfSize: (2 @ 0). str := StringMorph contents: self preference name font: (StrikeFont familyName: 'NewYork' size: 12). self preference localToProject ifTrue: [str emphasis: 1]. miniWrapper := AlignmentMorph newRow hResizing: #shrinkWrap; vResizing: #shrinkWrap. miniWrapper beTransparent addMorphBack: str lock. aPreferencesPanel ifNotNil: "We're in a Preferences panel" [miniWrapper on: #mouseDown send: #offerPreferenceNameMenu:with:in: to: self withValue: aPreferencesPanel. miniWrapper on: #mouseEnter send: #menuButtonMouseEnter: to: miniWrapper. miniWrapper on: #mouseLeave send: #menuButtonMouseLeave: to: miniWrapper. miniWrapper setBalloonText: 'Click here for a menu of options regarding this preference. Click on the checkbox to the left to toggle the setting of this preference'] ifNil: "We're a naked button, not in a panel" [miniWrapper setBalloonText: self preference helpString; setProperty: #balloonTarget toValue: aButton]. outerButton addMorphBack: miniWrapper. outerButton setNameTo: self preference name. aButton setBalloonText: self preference helpString. ^ outerButton "(Preferences preferenceAt: #balloonHelpEnabled) view tearOffButton"! ! !HaloThemePreferenceView methodsFor: 'user interface' stamp: 'hpt 9/24/2004 23:12'! haloThemeRadioButtons "Answer a column of butons representing the choices of halo theme" | buttonColumn aRow aRadioButton aStringMorph | buttonColumn := AlignmentMorph newColumn beTransparent. #( (iconicHaloSpecifications iconic iconicHalosInForce 'circular halos with icons inside') (classicHaloSpecs classic classicHalosInForce 'plain circular halos') (simpleFullHaloSpecifications simple simpleHalosInForce 'fewer, larger halos') (customHaloSpecs custom customHalosInForce 'customizable halos')) do: [:quad | aRow := AlignmentMorph newRow beTransparent. aRow addMorph: (aRadioButton := UpdatingThreePhaseButtonMorph radioButton). aRadioButton target: Preferences. aRadioButton setBalloonText: quad fourth. aRadioButton actionSelector: #installHaloTheme:. aRadioButton getSelector: quad third. aRadioButton arguments: (Array with: quad first). aRow addTransparentSpacerOfSize: (4 @ 0). aRow addMorphBack: (aStringMorph := StringMorph contents: quad second asString). aStringMorph setBalloonText: quad fourth. buttonColumn addMorphBack: aRow]. ^ buttonColumn "(Preferences preferenceAt: #haloTheme) view tearOffButton"! ! !HaloThemePreferenceView methodsFor: 'user interface' stamp: 'hpt 9/24/2004 23:11'! representativeButtonWithColor: aColor inPanel: aPreferencesPanel | outerButton editButton | editButton := SimpleButtonMorph new target: Preferences; color: Color transparent; actionSelector: #editCustomHalos; label: 'Edit custom halos' translated; setBalloonText: 'Click here to edit the method that defines the custom halos' translated. outerButton := AlignmentMorph newColumn. outerButton color: (aColor ifNil: [Color r: 0.645 g: 1.0 b: 1.0]); hResizing: (aPreferencesPanel ifNil: [#shrinkWrap] ifNotNil: [#spaceFill]); vResizing: #shrinkWrap; addTransparentSpacerOfSize: (0@4); addMorphBack: self haloThemeRadioButtons; addTransparentSpacerOfSize: (0@4); addMorphBack: editButton. ^outerButton. "(Preferences preferenceAt: #haloTheme) view tearOffButton" ! ! !PreferenceView class methodsFor: 'instance creation' stamp: 'hpt 9/24/2004 22:25'! preference: aPreference ^self new initializeWithPreference: aPreference; yourself! ! !PreferenceView class methodsFor: 'user interface' stamp: 'hpt 9/25/2004 18:35'! viewOrder "answer the order in which this view should appear relative to other views" ^1! ! !BooleanPreferenceView class methodsFor: 'user interface' stamp: 'hpt 9/25/2004 18:36'! viewOrder "I want to list first all the boolean preferences" ^1.! ! !HaloThemePreferenceView class methodsFor: 'class initialization' stamp: 'hpt 9/25/2004 13:36'! initialize "adding the halo theme preference to Preferences" Preferences addPreference: #haloTheme categories: {#halos} default: #iconicHaloSpecifications balloonHelp: '' projectLocal: false changeInformee: nil changeSelector: nil viewClass: HaloThemePreferenceView.! ! !HaloThemePreferenceView class methodsFor: 'user interface' stamp: 'hpt 9/25/2004 18:36'! viewOrder "after the boolean preferences I want the halo preference" ^2! ! !Preferences class methodsFor: 'add preferences' stamp: 'hpt 9/25/2004 12:51'! 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 addPreference: prefSymbol categories: categoryList default: defaultValue balloonHelp: helpString projectLocal: false changeInformee: nil changeSelector: nil viewClass: BooleanPreferenceView! ! !Preferences class methodsFor: 'add preferences' stamp: 'hpt 9/25/2004 13:05'! addPreference: prefSymbol categories: categoryList default: aValue balloonHelp: helpString projectLocal: localBoolean changeInformee: informeeSymbol changeSelector: aChangeSelector viewClass: aViewClass "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 viewClass: aViewClass. DictionaryOfPreferences at: prefSymbol put: aPreference. self compileAccessMethodForPreference: aPreference! ! !Preferences class methodsFor: 'halos' stamp: 'hpt 9/24/2004 23:34'! classicHalosInForce ^ (self preferenceAt: #haloTheme) preferenceValue == #classicHaloSpecs! ! !Preferences class methodsFor: 'halos' stamp: 'hpt 9/24/2004 23:34'! customHalosInForce ^ (self preferenceAt: #haloTheme) preferenceValue == #customHaloSpecs! ! !Preferences class methodsFor: 'halos' stamp: 'hpt 9/24/2004 23:34'! iconicHalosInForce ^ (self preferenceAt: #haloTheme) preferenceValue == #iconicHaloSpecifications! ! !Preferences class methodsFor: 'halos' stamp: 'hpt 9/24/2004 23:35'! installHaloTheme: themeSymbol self installHaloSpecsFromArray: (self perform: themeSymbol). (self preferenceAt: #haloTheme) preferenceValue: themeSymbol. ! ! !Preferences class methodsFor: 'halos' stamp: 'hpt 9/24/2004 23:34'! simpleHalosInForce ^ (self preferenceAt: #haloTheme) preferenceValue == #simpleFullHaloSpecifications! ! !Preferences class methodsFor: 'preferences panel' stamp: 'hpt 9/25/2004 11:49'! categoryNames | aSet | aSet := Set new. DictionaryOfPreferences do: [:aPreference | aSet addAll: (aPreference categoryList collect: [:aCategory | aCategory asSymbol])]. ^aSet.! ! !Preferences class methodsFor: 'preferences panel' stamp: 'hpt 9/24/2004 23:25'! 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 | controlPage addMorphBack: (aPreference view representativeButtonWithColor: cc inPanel: aPanel)]. 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/25/2004 11:49'! listOfCategories "Answer a list of category names for the preferences panel" ^ {#?}, self categoryNames asSortedArray, {#'search results'} "Preferences listOfCategories" ! ! !Preferences class methodsFor: 'preferences panel' stamp: 'hpt 9/25/2004 18:36'! 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 viewClass viewOrder < pref2 viewClass viewOrder) or: [(pref1 viewClass viewOrder = pref2 viewClass viewOrder) & (pref1 name < pref2 name)]]! ! !PreferencesPanel methodsFor: 'initialization' stamp: 'hpt 9/24/2004 22:39'! 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 | controlPage addMorphBack: (aPreference view representativeButtonWithColor: cc inPanel: self)]. aPalette world startSteppingSubmorphsOf: aPalette! ! PreferencesPanel removeSelector: #addHaloControlsTo:! PreferencesPanel removeSelector: #haloThemeRadioButtons! Preferences class removeSelector: #addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector:! HaloThemePreferenceView initialize! !HaloThemePreferenceView class reorganize! ('class initialization' initialize) ('user interface' viewOrder) ! !BooleanPreferenceView class reorganize! ('user interface' viewOrder) ! !PreferenceView class reorganize! ('instance creation' preference:) ('user interface' viewOrder) ! HaloThemePreferenceView removeSelector: #viewOrder! BooleanPreferenceView removeSelector: #viewOrder! PreferenceView removeSelector: #viewOrder! Preference removeSelector: #name:defaultValue:helpString:localToProject:categoryList:changeInformee:changeSelector:! Preference removeSelector: #offerPreferenceNameMenu:with:in:! Preference removeSelector: #representativeButtonWithColor:inPanel:! Preference removeSelector: #tearOffButton! Object subclass: #Preference instanceVariableNames: 'name value defaultValue helpString localToProject categoryList changeInformee changeSelector viewClass' classVariableNames: '' poolDictionaries: '' category: 'System-Support'! !Preference reorganize! ('initialization' categoryList: name:defaultValue:helpString:localToProject:categoryList:changeInformee:changeSelector:viewClass:) ('menu' categoryList copyName helpString name) ('value' defaultValue defaultValue: preferenceValue preferenceValue: rawValue: restoreDefaultValue togglePreferenceValue) ('local to project' isProjectLocalString localToProject toggleProjectLocalness) ('change notification' changeInformee:changeSelector: notifyInformeeOfChange) ('debugging' printOn:) ('*PreferenceBrowser-override') ('user interface' view viewClass viewClass:) ! "Postscript: Installing the BooleanPreferenceView to the existing preferences. We discard the #haloTheme preference because it was already initialized on the HaloThemePreferenceView class initialization " (Preference allInstances reject: [:ea | ea name == #haloTheme]) do: [:ea | ea viewClass: BooleanPreferenceView]. !