Smalltalk › Squeak › Squeak - Dev

[squeak-dev] The Inbox: PreferenceBrowser-MAD.38.mcz

_‹ Previous Topic Next Topic _›

Classic

List

Threaded

1 message

commits-2

[squeak-dev] The Inbox: PreferenceBrowser-MAD.38.mcz

A new version of PreferenceBrowser was added to project The Inbox:
http://source.squeak.org/inbox/PreferenceBrowser-MAD.38.mcz

==================== Summary ====================

Name: PreferenceBrowser-MAD.38
Author: MAD
Time: 6 October 2009, 7:37:01 am
UUID: 47f320bf-4474-44d5-89a8-fc58d3e631d7
Ancestors: PreferenceBrowser-ar.37

Selection highlighting in lists is now consistent with that in menus. I've made direct reference to Preferences menuSelectionColor - not sure if this will be seen as reasonable?

You should really tone down the highlight colour after loading these changes:
Preferences setParameter: #menuSelectionColor to: (Color r: 0.4 g: 0.5 b: 0.7)

==================== Snapshot ====================

SystemOrganization addCategory: #PreferenceBrowser!

Morph subclass: #PBPreferenceButtonMorph
instanceVariableNames: 'moreButton model preference preferenceMorphicView preferenceView'
classVariableNames: ''
poolDictionaries: ''
category: 'PreferenceBrowser'!

----- Method: PBPreferenceButtonMorph class>>preference: (in category 'instance creation') -----
preference: aPreference
^self preference: aPreference model: nil!

----- Method: PBPreferenceButtonMorph class>>preference:model: (in category 'instance creation') -----
preference: aPreference model: aModel
^self new
initializeWithPreference: aPreference model: aModel;
yourself.!

----- Method: PBPreferenceButtonMorph>>actionButtons (in category 'extra controls') -----
actionButtons
^self preferenceView actions collect: [:aTuple |
self basicButton
label: aTuple first;
target: aTuple second;
actionSelector: aTuple third;
arguments: aTuple fourth;
setBalloonText: aTuple fifth ]!

----- Method: PBPreferenceButtonMorph>>addExtraControls (in category 'extra controls') -----
addExtraControls
| m |
m := self horizontalPanel
cellInset: 3;
addAllMorphs: self actionButtons;
addMorphBack: self horizontalFiller;
addMorphBack: self moreButton;
yourself.
self
addMorphBack: (self blankSpaceOf: 2@2);
addMorphBack: self preferenceHelpTextMorph;
fullBounds; "to force a layout compute needed by the textMorphs's autoFit"
addMorphBack: m
!

----- Method: PBPreferenceButtonMorph>>advancedOptionsSelected (in category 'extra controls') -----
advancedOptionsSelected
self preferenceView offerPreferenceNameMenu: self model!

----- Method: PBPreferenceButtonMorph>>basicButton (in category 'utility methods') -----
basicButton
| button |
button := SimpleButtonMorph new.
button
borderWidth: 1;
borderColor: self paneColor;
on: #mouseEnter send: #value to: [button borderWidth: 2];
on: #mouseLeave send: #value to: [button borderWidth: 1];
vResizing: #rigid;
height: (TextStyle defaultFont height + 4);
useSquareCorners;
clipSubmorphs: true;
color: self paneColor muchLighter;
target: self.
^button!

----- Method: PBPreferenceButtonMorph>>basicPanel (in category 'utility methods') -----
basicPanel
^BorderedMorph new
beTransparent;
extent: 0@0;
borderWidth: 0;
layoutInset: 0;
cellInset: 0;
layoutPolicy: TableLayout new;
listCentering: #topLeft;
cellPositioning: #center;
hResizing: #spaceFill;
vResizing: #shrinkWrap;
yourself!

----- Method: PBPreferenceButtonMorph>>blankSpaceOf: (in category 'utility methods') -----
blankSpaceOf: aPoint
^Morph new
beTransparent;
extent: aPoint;
yourself!

----- Method: PBPreferenceButtonMorph>>caseInsensitiveBeginsWith:in: (in category 'utility methods') -----
caseInsensitiveBeginsWith: prefix in: string
^(string findString: prefix startingAt: 1 caseSensitive: false) = 1!

----- Method: PBPreferenceButtonMorph>>highlightOff (in category 'highlighting') -----
highlightOff
self beTransparent.
self label color: Color black.
self removeExtraControls.!

----- Method: PBPreferenceButtonMorph>>highlightOn (in category 'highlighting') -----
highlightOn

self color: (Color gray alpha: 0.1).

self addExtraControls.!

----- Method: PBPreferenceButtonMorph>>horizontalFiller (in category 'utility methods') -----
horizontalFiller
^self horizontalPanel
hResizing: #spaceFill;
yourself.!

----- Method: PBPreferenceButtonMorph>>horizontalPanel (in category 'utility methods') -----
horizontalPanel
^self basicPanel
cellPositioning: #center;
listDirection: #leftToRight;
yourself.!

----- Method: PBPreferenceButtonMorph>>initializeLayout (in category 'initialization') -----
initializeLayout
self layoutPolicy: TableLayout new;
beTransparent;
layoutInset: 0;
cellInset: 0;
listCentering: #topLeft;
cellPositioning: #topLeft;
listDirection: #topToBottom;
hResizing: #spaceFill;
vResizing: #shrinkWrap. !

----- Method: PBPreferenceButtonMorph>>initializeWithPreference:model: (in category 'initialization') -----
initializeWithPreference: aPreference model: aModel
preference := aPreference.
model := aModel.
self initializeLayout.
self addMorphBack: self preferenceMorphicView.
self highlightOff.!

----- Method: PBPreferenceButtonMorph>>label (in category 'preference accessing') -----
label
^self preferenceMorphicView firstSubmorph!

----- Method: PBPreferenceButtonMorph>>model (in category 'accessing') -----
model
^model!

----- Method: PBPreferenceButtonMorph>>moreButton (in category 'extra controls') -----
moreButton
^moreButton ifNil:
[moreButton := self basicButton
label: 'more' translated;
setBalloonText:
'Click here for advanced options'translated;
actionSelector: #advancedOptionsSelected]!

----- Method: PBPreferenceButtonMorph>>paneColor (in category 'utility methods') -----
paneColor
| browser |
browser := (self ownerChain
detect: [:ea | ea isKindOf: PreferenceBrowserMorph]
ifNone: [^Color black]) .
^browser paneColor!

----- Method: PBPreferenceButtonMorph>>preference (in category 'preference accessing') -----
preference
^preference!

----- Method: PBPreferenceButtonMorph>>preferenceHelp (in category 'preference accessing') -----
preferenceHelp
| help name |
help := self preference helpString withBlanksTrimmed.
name := self preference name.
(self caseInsensitiveBeginsWith: name in: help)
ifTrue: [help := help allButFirst: name size].
(help notEmpty and: [help first = $:])
ifTrue: [help := help allButFirst].
^help withBlanksTrimmed.
!

----- Method: PBPreferenceButtonMorph>>preferenceHelpText (in category 'preference accessing') -----
preferenceHelpText
^self preferenceHelp asText
addAttribute: TextEmphasis italic;
yourself.!

----- Method: PBPreferenceButtonMorph>>preferenceHelpTextMorph (in category 'extra controls') -----
preferenceHelpTextMorph
| text tm |
text := self preferenceHelpText.
tm := TextMorph new
contents: text;
wrapOnOff;
hResizing: #spaceFill;
vResizing: #shrinkWrap;
lock: true;
visible: text notEmpty;
yourself. "we don't want an empty textmorph showing"
tm isAutoFit
ifFalse: [tm autoFitOnOff].
^tm.!

----- Method: PBPreferenceButtonMorph>>preferenceMorphicView (in category 'preference accessing') -----
preferenceMorphicView
^preferenceMorphicView
ifNil:
[preferenceMorphicView := self preferenceView
representativeButtonWithColor: Color transparent inPanel: self model.
preferenceMorphicView hResizing: #spaceFill.
^preferenceMorphicView]!

----- Method: PBPreferenceButtonMorph>>preferenceView (in category 'preference accessing') -----
preferenceView
^preferenceView
ifNil: [preferenceView := self preference viewForPanel: self model.]!

----- Method: PBPreferenceButtonMorph>>removeExtraControls (in category 'extra controls') -----
removeExtraControls
self submorphs copyWithoutFirst do: [:ea | ea delete]!

----- Method: PBPreferenceButtonMorph>>verticalPanel (in category 'utility methods') -----
verticalPanel
^self basicPanel
cellPositioning: #topLeft;
listDirection: #topToBottom;
yourself.!

Object subclass: #PreferenceView
instanceVariableNames: 'preference'
classVariableNames: ''
poolDictionaries: ''
category: 'PreferenceBrowser'!
PreferenceView class
instanceVariableNames: 'registeredClasses'!

!PreferenceView commentStamp: '<historical>' prior: 0!
My subclasses instances are responsible for building the visual representation of each kind of preference.!

PreferenceView subclass: #PBPreferenceView
instanceVariableNames: 'actions'
classVariableNames: ''
poolDictionaries: ''
category: 'PreferenceBrowser'!

!PBPreferenceView commentStamp: '<historical>' prior: 0!
I am just a refactor of all the common method of the PreferenceBrowser preference views!

PBPreferenceView subclass: #PBBooleanPreferenceView
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PreferenceBrowser'!

!PBBooleanPreferenceView commentStamp: '<historical>' prior: 0!
I am responsible for building the visual representation of a preference that accepts true and false values. This view is aimed to be used inside a PreferenceBrowser panel.!

----- Method: PBBooleanPreferenceView class>>initialize (in category 'class initialization') -----
initialize
PreferenceViewRegistry ofBooleanPreferences register: self.
!

----- Method: PBBooleanPreferenceView class>>unload (in category 'class initialization') -----
unload
PreferenceViewRegistry ofBooleanPreferences unregister: self.!

----- Method: PBBooleanPreferenceView>>enabledButton (in category 'user interface') -----
enabledButton
| aButton aLabel |
aButton := UpdatingThreePhaseButtonMorph checkBox
target: self preference;
actionSelector: #togglePreferenceValue;
getSelector: #preferenceValue;
yourself.
aLabel := (StringMorph contents: 'enabled' translated
font: (StrikeFont familyName: TextStyle defaultFont familyName
size: TextStyle defaultFont pointSize - 1)).
^self horizontalPanel
addMorphBack: aButton;
addMorphBack: aLabel;
yourself.!

----- Method: PBBooleanPreferenceView>>localToProjectButton (in category 'user interface') -----
localToProjectButton
| aButton aLabel |
aButton := UpdatingThreePhaseButtonMorph checkBox
target: self preference;
actionSelector: #toggleProjectLocalness;
getSelector: #localToProject;
yourself.
aLabel := (StringMorph contents: 'local' translated
font: (StrikeFont familyName: TextStyle defaultFont familyName
size: TextStyle defaultFont pointSize - 1)).
^self horizontalPanel
addMorphBack: aButton;
addMorphBack: aLabel;
yourself.!

----- Method: PBBooleanPreferenceView>>representativeButtonWithColor:inPanel: (in category 'user interface') -----
representativeButtonWithColor: aColor inPanel: aPreferencesPanel
^self horizontalPanel
layoutInset: 2;
cellInset: 7;
color: aColor;
addMorphBack: (StringMorph contents: self preference name);
addMorphBack: self horizontalFiller;
addMorphBack: self enabledButton;
addMorphBack: self localToProjectButton;
yourself.!

PBPreferenceView subclass: #PBColorPreferenceView
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PreferenceBrowser'!

----- Method: PBColorPreferenceView class>>initialize (in category 'class initialization') -----
initialize
PreferenceViewRegistry ofColorPreferences register: self.!

----- Method: PBColorPreferenceView class>>unload (in category 'class initialization') -----
unload
PreferenceViewRegistry ofColorPreferences unregister: self.!

----- Method: PBColorPreferenceView>>colorSwatch (in category 'user interface') -----
colorSwatch
^UpdatingRectangleMorph new
target: self preference;
getSelector: #preferenceValue;
putSelector: #preferenceValue:;
extent: 22@22;
setBalloonText: 'click here to change the color' translated;
yourself.!

----- Method: PBColorPreferenceView>>representativeButtonWithColor:inPanel: (in category 'user interface') -----
representativeButtonWithColor: aColor inPanel: aPreferenceBrowser
^self horizontalPanel
layoutInset: 2;
color: aColor;
cellInset: 20;
cellPositioning: #center;
addMorphBack: (StringMorph contents: self preference name);
addMorphBack: self horizontalFiller;
addMorphBack: self colorSwatch;
yourself!

PBColorPreferenceView subclass: #PBWindowColorPreferenceView
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PreferenceBrowser'!

----- Method: PBWindowColorPreferenceView class>>initialize (in category 'class initialization') -----
initialize
self viewRegistry register: self.!

----- Method: PBWindowColorPreferenceView class>>unload (in category 'class initialization') -----
unload
self viewRegistry unregister: self.!

----- Method: PBWindowColorPreferenceView class>>viewRegistry (in category 'class initialization') -----
viewRegistry
^(PreferenceViewRegistry registryOf: #windowColorPreferences)
viewOrder: 6;
yourself.!

----- Method: PBWindowColorPreferenceView>>initialize (in category 'initialization') -----
initialize
super initialize.
self addActionTitled: 'Bright' target: Preferences selector: #installBrightWindowColors arguments: {} balloonText: 'Use standard bright colors for all windows' translated.
self addActionTitled: 'Pastel' target: Preferences selector: #installPastelWindowColors arguments: {} balloonText: 'Use standard pastel colors for all windows' translated.
self addActionTitled: 'White' target: Preferences selector: #installUniformWindowColors arguments: {} balloonText: 'Use white backgrounds for all standard windows' translated.!

PBPreferenceView subclass: #PBHaloThemePreferenceView
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PreferenceBrowser'!

!PBHaloThemePreferenceView commentStamp: '<historical>' prior: 0!
I am responsible for building the button for the Halo Theme preference!

----- Method: PBHaloThemePreferenceView class>>initialize (in category 'class initialization') -----
initialize
PreferenceViewRegistry ofHaloThemePreferences register: self.!

----- Method: PBHaloThemePreferenceView class>>unload (in category 'class initialization') -----
unload
PreferenceViewRegistry ofHaloThemePreferences unregister: self.!

----- Method: PBHaloThemePreferenceView>>haloThemeRadioButtons (in category 'user interface') -----
haloThemeRadioButtons
"Answer a column of butons representing the choices of halo theme"

| buttonColumn aRow aRadioButton aLabel |
buttonColumn := self verticalPanel.
#( (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 |
aRadioButton := UpdatingThreePhaseButtonMorph radioButton
target: Preferences;
setBalloonText: quad fourth;
actionSelector: #installHaloTheme:;
getSelector: quad third;
arguments: (Array with: quad first);
yourself.
aLabel := (StringMorph contents: quad second asString)
setBalloonText: quad fourth;
yourself.
aRow := self horizontalPanel
cellInset: 4;
addMorphBack: aRadioButton;
addMorphBack: aLabel.
buttonColumn addMorphBack: aRow].
^ buttonColumn

"(Preferences preferenceAt: #haloTheme) view tearOffButton"!

----- Method: PBHaloThemePreferenceView>>initialize (in category 'initialization') -----
initialize
self addActionTitled: 'edit custom halos'
target: Preferences
selector: #editCustomHalos
arguments: {}
balloonText: 'Click here to edit the method that defines the custom halos' translated.!

----- Method: PBHaloThemePreferenceView>>representativeButtonWithColor:inPanel: (in category 'user interface') -----
representativeButtonWithColor: aColor inPanel: aPreferencesPanel
| innerPanel |
innerPanel := self horizontalPanel
addMorphBack: (self blankSpaceOf: 10@0);
addMorphBack: self haloThemeRadioButtons;
yourself.
^self verticalPanel
color: aColor;
layoutInset: 2;
addMorphBack: (StringMorph contents: self preference name);
addMorphBack: innerPanel.!

PBPreferenceView subclass: #PBNumericPreferenceView
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PreferenceBrowser'!

----- Method: PBNumericPreferenceView class>>initialize (in category 'class initialization') -----
initialize
PreferenceViewRegistry ofNumericPreferences register: self.!

----- Method: PBNumericPreferenceView class>>unload (in category 'class initialization') -----
unload
PreferenceViewRegistry ofNumericPreferences unregister: self.!

----- Method: PBNumericPreferenceView>>preferenceValue (in category 'user interface') -----
preferenceValue
^self preference preferenceValue asString!

----- Method: PBNumericPreferenceView>>preferenceValue: (in category 'user interface') -----
preferenceValue: aTextOrString
(aTextOrString notEmpty and: [aTextOrString asString isAllDigits])
ifFalse: [^false].
self preference preferenceValue: aTextOrString asNumber.
^true.!

----- Method: PBNumericPreferenceView>>representativeButtonWithColor:inPanel: (in category 'user interface') -----
representativeButtonWithColor: aColor inPanel: aPreferenceBrowser
^self horizontalPanel
layoutInset: 2;
color: aColor;
cellInset: 20;
cellPositioning: #center;
addMorphBack: (StringMorph contents: self preference name);
addMorphBack: self textField;
yourself.!

----- Method: PBNumericPreferenceView>>textField (in category 'user interface') -----
textField
^(PluggableTextMorph
on: self
text: #preferenceValue
accept: #preferenceValue:)
hideVScrollBarIndefinitely: true;
borderColor: #inset;
acceptOnCR: true;
color: Color gray veryMuchLighter;
vResizing: #rigid;
hResizing: #spaceFill;
height: TextStyle defaultFont height + 6;
yourself.!

----- Method: PBPreferenceView class>>handlesPanel: (in category 'view registry') -----
handlesPanel: aPreferencePanel
^aPreferencePanel isKindOf: PreferenceBrowser!

----- Method: PBPreferenceView>>actions (in category 'actions') -----
actions
^actions ifNil: [actions := OrderedCollection new.]!

----- Method: PBPreferenceView>>addActionTitled:target:selector:arguments:balloonText: (in category 'actions') -----
addActionTitled: aTitle target: aTarget selector: aSelector arguments: aCollection balloonText: aText
self actions add: { aTitle. aTarget. aSelector. aCollection. aText }!

----- Method: PBPreferenceView>>basicPanel (in category 'user interface') -----
basicPanel
^BorderedMorph new
beTransparent;
extent: 0@0;
borderWidth: 0;
layoutInset: 0;
cellInset: 2;
layoutPolicy: TableLayout new;
listCentering: #topLeft;
cellPositioning: #center;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
yourself!

----- Method: PBPreferenceView>>blankSpaceOf: (in category 'user interface') -----
blankSpaceOf: aPoint
^Morph new
beTransparent;
extent: aPoint;
yourself!

----- Method: PBPreferenceView>>horizontalFiller (in category 'user interface') -----
horizontalFiller
^self horizontalPanel
hResizing: #spaceFill;
yourself.!

----- Method: PBPreferenceView>>horizontalPanel (in category 'user interface') -----
horizontalPanel
^self basicPanel
cellPositioning: #center;
listDirection: #leftToRight;
yourself.!

----- Method: PBPreferenceView>>offerPreferenceNameMenu: (in category 'user interface') -----
offerPreferenceNameMenu: aPreferenceBrowser
"the user clicked on a preference name -- put up a menu"

| aMenu |
aMenu := MenuMorph new
defaultTarget: self preference;
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' translated 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: aPreferenceBrowser 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!

----- Method: PBPreferenceView>>verticalPanel (in category 'user interface') -----
verticalPanel
^self basicPanel
cellPositioning: #topLeft;
listDirection: #topToBottom;
yourself.!

PBPreferenceView subclass: #PBTextPreferenceView
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PreferenceBrowser'!

----- Method: PBTextPreferenceView class>>initialize (in category 'class initialization') -----
initialize
PreferenceViewRegistry ofTextPreferences register: self.!

----- Method: PBTextPreferenceView class>>unload (in category 'class initialization') -----
unload
PreferenceViewRegistry ofTextPreferences unregister: self.!

----- Method: PBTextPreferenceView>>preferenceValue (in category 'user interface') -----
preferenceValue
^self preference preferenceValue ifNil: ['']!

----- Method: PBTextPreferenceView>>preferenceValue: (in category 'user interface') -----
preferenceValue: aTextOrString
self preference preferenceValue: aTextOrString asString.
^true.!

----- Method: PBTextPreferenceView>>representativeButtonWithColor:inPanel: (in category 'user interface') -----
representativeButtonWithColor: aColor inPanel: aPreferenceBrowser
^self horizontalPanel
layoutInset: 2;
color: aColor;
cellInset: 20;
cellPositioning: #center;
addMorphBack: (StringMorph contents: self preference name);
addMorphBack: self textField;
yourself.!

----- Method: PBTextPreferenceView>>textField (in category 'user interface') -----
textField
^(PluggableTextMorph
on: self
text: #preferenceValue
accept: #preferenceValue:)
hideVScrollBarIndefinitely: true;
borderColor: #inset;
acceptOnCR: true;
color: Color gray veryMuchLighter;
vResizing: #rigid;
hResizing: #spaceFill;
height: TextStyle defaultFont height + 6;
yourself.!

----- Method: PreferenceView class>>handlesPanel: (in category 'view registry') -----
handlesPanel: aPreferencePanel
self subclassResponsibility !

----- Method: PreferenceView class>>preference: (in category 'instance creation') -----
preference: aPreference
^self new
initializeWithPreference: aPreference;
yourself!

----- Method: PreferenceView>>initializeWithPreference: (in category 'initialization') -----
initializeWithPreference: aPreference
preference := aPreference!

----- Method: PreferenceView>>preference (in category 'accessing') -----
preference
^preference!

----- Method: PreferenceView>>representativeButtonWithColor:inPanel: (in category 'user interface') -----
representativeButtonWithColor: aColor inPanel: aPreferencesPanel
self subclassResponsibility !

----- Method: PreferenceView>>tearOffButton (in category 'user interface') -----
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!

Object subclass: #PreferenceViewRegistry
instanceVariableNames: 'registeredClasses viewOrder'
classVariableNames: ''
poolDictionaries: ''
category: 'PreferenceBrowser'!
PreferenceViewRegistry class
instanceVariableNames: 'registries'!

!PreferenceViewRegistry commentStamp: '<historical>' 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.!

----- Method: PreferenceViewRegistry class>>forType: (in category 'accessing') -----
forType: typeName
"Answer the preference registry for the given type name"
^typeName caseOf:{
[#Boolean] -> [self ofBooleanPreferences].
[#Color] -> [self ofColorPreferences].
[#Font] -> [self ofFontPreferences].
[#Number] -> [self ofNumericPreferences].
[#String] -> [self ofTextPreferences].
[#Halo] -> [self ofHaloThemePreferences].
[#WindowColor] -> [self registryOf: #windowColorPreferences]
} otherwise:[self registryOf: typeName].!

----- Method: PreferenceViewRegistry class>>initialize (in category 'class initialization') -----
initialize
"Ensure we aren't carrying obsolete references"
self removeObsolete.!

----- Method: PreferenceViewRegistry class>>ofBooleanPreferences (in category 'instance creation') -----
ofBooleanPreferences
^(self registryOf: #booleanPreferences)
viewOrder: 1;
yourself.!

----- Method: PreferenceViewRegistry class>>ofColorPreferences (in category 'instance creation') -----
ofColorPreferences
^(self registryOf: #colorPreferences)
viewOrder: 5;
yourself.!

----- Method: PreferenceViewRegistry class>>ofFontPreferences (in category 'instance creation') -----
ofFontPreferences
^(self registryOf: #fontPreferences)
viewOrder: 4;
yourself.!

----- Method: PreferenceViewRegistry class>>ofHaloThemePreferences (in category 'instance creation') -----
ofHaloThemePreferences
^(self registryOf: #haloThemePreferences)
viewOrder: 2;
yourself.!

----- Method: PreferenceViewRegistry class>>ofNumericPreferences (in category 'instance creation') -----
ofNumericPreferences
^(self registryOf: #numericPreferences)
viewOrder: 3;
yourself.!

----- Method: PreferenceViewRegistry class>>ofTextPreferences (in category 'instance creation') -----
ofTextPreferences
^(self registryOf: #textPreferences)
viewOrder: 3;
yourself.!

----- Method: PreferenceViewRegistry class>>registries (in category 'instance creation') -----
registries
^registries ifNil: [registries := Dictionary new]!

----- Method: PreferenceViewRegistry class>>registryOf: (in category 'instance creation') -----
registryOf: aSymbol
^self registries at: aSymbol ifAbsentPut: [self new]!

----- Method: PreferenceViewRegistry class>>removeObsolete (in category 'class initialization') -----
removeObsolete
"PreferenceViewRegistry removeObsolete"
"Remove obsolete entries from the registries"
self registries do:[:viewRegistry|
viewRegistry registeredClasses copy do:[:rClass|
rClass isObsolete ifTrue:[viewRegistry unregister: rClass]]].!

----- Method: PreferenceViewRegistry class>>typeOfRegistry: (in category 'accessing') -----
typeOfRegistry: aRegistry
"Answer the type name for a particular view registry"
^aRegistry caseOf:{
[self ofBooleanPreferences] -> [#Boolean].
[self ofColorPreferences] -> [#Color].
[self ofFontPreferences] -> [#Font].
[self ofNumericPreferences] -> [#Number].
[self ofTextPreferences] -> [#String].
[self ofHaloThemePreferences] -> [#Halo].
[self registryOf: #windowColorPreferences] -> [#WindowColor].
} otherwise:[self registries keyAtIdentityValue: aRegistry ifAbsent:[nil]].!

----- Method: PreferenceViewRegistry>>initialize (in category 'initialize-release') -----
initialize
viewOrder := 1.!

----- Method: PreferenceViewRegistry>>register: (in category 'view registry') -----
register: aProviderClass
(self registeredClasses includes: aProviderClass)
ifFalse: [self registeredClasses add: aProviderClass].!

----- Method: PreferenceViewRegistry>>registeredClasses (in category 'view registry') -----
registeredClasses
^registeredClasses ifNil: [registeredClasses := OrderedCollection new]!

----- Method: PreferenceViewRegistry>>unregister: (in category 'view registry') -----
unregister: aProviderClass
self registeredClasses remove: aProviderClass ifAbsent: []!

----- Method: PreferenceViewRegistry>>viewClassFor: (in category 'view registry') -----
viewClassFor: aPreferencePanel
^self registeredClasses
detect: [:aViewClass| aViewClass handlesPanel: aPreferencePanel]
ifNone: [].!

----- Method: PreferenceViewRegistry>>viewOrder (in category 'view order') -----
viewOrder
"answer the order in which the registered views should appear relative to the other views"
^viewOrder!

----- Method: PreferenceViewRegistry>>viewOrder: (in category 'view order') -----
viewOrder: aNumber
viewOrder := aNumber!

Model subclass: #PreferenceBrowser
instanceVariableNames: 'selectedCategoryIndex selectedPreference searchPattern searchResults lastExecutedSearch preferences title'
classVariableNames: ''
poolDictionaries: ''
category: 'PreferenceBrowser'!

----- Method: PreferenceBrowser class>>initialize (in category 'class initialization') -----
initialize
self
registerWindowColor;
registerInOpenMenu;
registerInFlaps!

----- Method: PreferenceBrowser class>>open (in category 'instance creation') -----
open
| browser |
browser := self new.
(PreferenceBrowserMorph withModel: browser)
openInWorld.
^browser. !

----- Method: PreferenceBrowser class>>prototypicalToolWindow (in category 'instance creation') -----
prototypicalToolWindow
| window |
window := PreferenceBrowserMorph withModel: self new.
window applyModelExtent.
^window!

----- Method: PreferenceBrowser class>>registerInFlaps (in category 'class initialization') -----
registerInFlaps
Flaps
registerQuad:
{ #PreferenceBrowser.
#prototypicalToolWindow.
'Preference Browser' translated.
'A tool for expressing personal preferences for numerous options' translated }
forFlapNamed: 'Tools' translated.
Flaps replaceToolsFlap!

----- Method: PreferenceBrowser class>>registerInOpenMenu (in category 'class initialization') -----
registerInOpenMenu
(TheWorldMenu respondsTo: #registerOpenCommand:) ifTrue: [
TheWorldMenu unregisterOpenCommand: 'Preference Browser'.
TheWorldMenu registerOpenCommand: {'Preference Browser'. {self. #open}}].
!

----- Method: PreferenceBrowser class>>registerWindowColor (in category 'class initialization') -----
registerWindowColor
(Preferences windowColorFor: self name) = Color white
ifTrue: [ Preferences setWindowColorFor: self name to: (Color colorFrom: self windowColorSpecification brightColor) ].!

----- Method: PreferenceBrowser class>>unload (in category 'class initialization') -----
unload
self
unregisterFromOpenMenu;
unregisterFromFlaps.!

----- Method: PreferenceBrowser class>>unregisterFromFlaps (in category 'class initialization') -----
unregisterFromFlaps
Flaps
unregisterQuadsWithReceiver: self;
replaceToolsFlap!

----- Method: PreferenceBrowser class>>unregisterFromOpenMenu (in category 'class initialization') -----
unregisterFromOpenMenu
(TheWorldMenu respondsTo: #registerOpenCommand:)
ifTrue: [TheWorldMenu unregisterOpenCommand: 'Preference Browser'].
!

----- Method: PreferenceBrowser class>>windowColorSpecification (in category 'window color') -----
windowColorSpecification
"Answer a WindowColorSpec object that declares my preference"

^ WindowColorSpec classSymbol: self name wording: 'Preference Browser' brightColor: #(0.645 1.0 1.0) pastelColor: #(0.886 1.0 1.0) helpMessage: 'A tool for expressing personal preferences for numerous options.'!

----- Method: PreferenceBrowser>>allCategoryLabel (in category 'user interface') -----
allCategoryLabel
^'-- all --' translated!

----- Method: PreferenceBrowser>>allCategorySelected (in category 'accessing') -----
allCategorySelected
^self selectedCategory = self allCategoryLabel!

----- Method: PreferenceBrowser>>allPreferences (in category 'accessing') -----
allPreferences
^ preferences allPreferenceObjects asSortedCollection:
[:pref1 :pref2 |
pref1 viewRegistry viewOrder <pref2 viewRegistry viewOrder or:
[pref1 viewRegistry viewOrder =pref2 viewRegistry viewOrder
&(pref1 name <pref2 name)]]!

----- Method: PreferenceBrowser>>categoryList (in category 'accessing') -----
categoryList
^OrderedCollection new
add: self allCategoryLabel;
addAll: preferences categoryNames asSortedCollection;
add: self searchResultsCategoryLabel;
yourself.

!

----- Method: PreferenceBrowser>>defaultSelected (in category 'preferences search') -----
defaultSelected
Preferences chooseInitialSettings!

----- Method: PreferenceBrowser>>findCategoryFromPreference: (in category 'find') -----
findCategoryFromPreference: prefSymbol
"Find all categories in which the preference occurs"

| aMenu|
aMenu := MenuMorph new defaultTarget: self.
(preferences categoriesContainingPreference: prefSymbol) do:
[:aCategory | aMenu add: aCategory target: self selector: #selectedCategory: argument: aCategory].
aMenu popUpInWorld!

----- Method: PreferenceBrowser>>helpSelected (in category 'preferences search') -----
helpSelected
"Open up a workspace with explanatory info in it about the Preference Browser"
Workspace new
contents: self helpText;
openLabel: self windowTitle.!

----- Method: PreferenceBrowser>>helpText (in category 'preferences search') -----
helpText
^(String streamContents: [:str |
str nextPutAll:
'Many aspects of the system are goberned by the settings of various ''Preferences''.

Click on any of the categories shown at the left list to see all the preferences in that category. Or type into the search box at the bottom of the window, then hit Search, and all Preferences matching whatever you typed in will appear in the ''search results'' category. A preference is considered to match your search if either its name matches the text *or* if anything in the preference''s help text does.

To find out more about any particular Preference just select it and its help text will appear.

Some preferences can be ''local'' instead of global. When a preference is set as global its value will apply to whatever project you are in. A local preference will only be valid in the project that you set it in.

The ''Save'' button allow you to quickly save your current settings so it can later be restored with the ''Load'' button.

To carry your settings to another Squeak you might want to use the ''Save to disk'' and ''Load from disk'' buttons. The save to disk option will store all your settings in a ''my.prefs'' file in your Squeak''s current directory.

Lastly, you can use the "theme..." button to set multiple preferences all at once; click on the "theme..." button and try the themes already provided with your Squeak image.']) translated!

----- Method: PreferenceBrowser>>initialExtent (in category 'user interface') -----
initialExtent
^ 520@440!

----- Method: PreferenceBrowser>>initialize (in category 'initialize-release') -----
initialize
preferences := Preferences.
title := 'Preference Browser'.!

----- Method: PreferenceBrowser>>lastExecutedSearch (in category 'accessing') -----
lastExecutedSearch
^lastExecutedSearch!

----- Method: PreferenceBrowser>>lastExecutedSearch: (in category 'accessing') -----
lastExecutedSearch: aTextOrString
^lastExecutedSearch:= aTextOrString!

----- Method: PreferenceBrowser>>loadFromDiskSelected (in category 'preferences search') -----
loadFromDiskSelected
preferences restorePreferencesFromDisk!

----- Method: PreferenceBrowser>>loadSelected (in category 'preferences search') -----
loadSelected
preferences restorePersonalPreferences !

----- Method: PreferenceBrowser>>nonSpecialCategorySelected (in category 'accessing') -----
nonSpecialCategorySelected
^self allCategorySelected not & self searchResultsCategorySelected not!

----- Method: PreferenceBrowser>>preferences (in category 'accessing') -----
preferences
^ preferences!

----- Method: PreferenceBrowser>>preferencesInCategory: (in category 'accessing') -----
preferencesInCategory: aCategory
^(preferences preferenceObjectsInCategory: aCategory) asSortedCollection:
[:pref1 :pref2 |
pref1 viewRegistry viewOrder <pref2 viewRegistry viewOrder or:
[pref1 viewRegistry viewOrder =pref2 viewRegistry viewOrder
&(pref1 name <pref2 name)]]!

----- Method: PreferenceBrowser>>saveSelected (in category 'preferences search') -----
saveSelected
preferences savePersonalPreferences !

----- Method: PreferenceBrowser>>saveToDiskSelected (in category 'preferences search') -----
saveToDiskSelected
preferences storePreferencesToDisk!

----- Method: PreferenceBrowser>>searchFieldLegend (in category 'accessing') -----
searchFieldLegend
^''.!

----- Method: PreferenceBrowser>>searchPattern (in category 'accessing') -----
searchPattern
^searchPattern ifNil: [searchPattern := self searchFieldLegend]!

----- Method: PreferenceBrowser>>searchPattern: (in category 'accessing') -----
searchPattern: aStringOrText
aStringOrText
ifEmpty: [searchPattern := self searchFieldLegend]
ifNotEmpty: [searchPattern := aStringOrText asString].
self changed: #searchPattern.
^true!

----- Method: PreferenceBrowser>>searchPreferencesFor: (in category 'preferences search') -----
searchPreferencesFor: pattern
| result |
result := pattern asString asLowercase withBlanksTrimmed.
result ifEmpty: [^self].
searchResults := self allPreferences select: [:aPreference |
(aPreference name includesSubstring: result caseSensitive: false) or:
[aPreference helpString includesSubstring: result caseSensitive: false]].
self selectSearchResultsCategory.
self lastExecutedSearch: pattern.
!

----- Method: PreferenceBrowser>>searchResults (in category 'accessing') -----
searchResults
^searchResults ifNil: [searchResults := #()]!

----- Method: PreferenceBrowser>>searchResultsCategoryLabel (in category 'user interface') -----
searchResultsCategoryLabel
^'-- search results --' translated!

----- Method: PreferenceBrowser>>searchResultsCategorySelected (in category 'accessing') -----
searchResultsCategorySelected
^self selectedCategory = self searchResultsCategoryLabel!

----- Method: PreferenceBrowser>>searchSelected (in category 'buttons callbacks') -----
searchSelected
self searchPreferencesFor: self searchPattern.!

----- Method: PreferenceBrowser>>selectFirstPreferenceOrNil (in category 'accessing') -----
selectFirstPreferenceOrNil
| prefs |
self selectedCategory
ifNil: [^self selectedPreference: nil].
prefs := self preferencesInCategory: self selectedCategory.
prefs isEmpty
ifTrue: [^self selectedPreference: nil].
self selectedPreference: prefs first.!

----- Method: PreferenceBrowser>>selectSearchResultsCategory (in category 'accessing') -----
selectSearchResultsCategory
self selectedCategoryIndex: (self categoryList indexOf: self searchResultsCategoryLabel)!

----- Method: PreferenceBrowser>>selectedCategory (in category 'accessing') -----
selectedCategory
^self categoryList at: selectedCategoryIndex ifAbsent: []!

----- Method: PreferenceBrowser>>selectedCategory: (in category 'accessing') -----
selectedCategory: aCategorySymbol
self selectedCategoryIndex: (self categoryList indexOf: aCategorySymbol ifAbsent: [0]).!

----- Method: PreferenceBrowser>>selectedCategoryIndex (in category 'accessing') -----
selectedCategoryIndex
^selectedCategoryIndex ifNil: [selectedCategoryIndex := 0].!

----- Method: PreferenceBrowser>>selectedCategoryIndex: (in category 'accessing') -----
selectedCategoryIndex: anIndex
anIndex = 0
ifTrue: [^self].
self selectedPreference: nil.
selectedCategoryIndex := anIndex.
self changed: #selectedCategoryIndex.!

----- Method: PreferenceBrowser>>selectedCategoryPreferences (in category 'accessing') -----
selectedCategoryPreferences
self allCategorySelected
ifTrue: [^self allPreferences].
self searchResultsCategorySelected
ifTrue: [^self searchResults].
^self preferencesInCategory: self selectedCategory.
!

----- Method: PreferenceBrowser>>selectedPreference (in category 'accessing') -----
selectedPreference
^selectedPreference!

----- Method: PreferenceBrowser>>selectedPreference: (in category 'accessing') -----
selectedPreference: aPreference
selectedPreference := aPreference.
self changed: #selectedPreference.
self changed: #selectedPreferenceIndex.
self changed: #selectedPreferenceHelpText.!

----- Method: PreferenceBrowser>>selectedPreferenceHelpText (in category 'accessing') -----
selectedPreferenceHelpText
self selectedPreference
ifNil: [^''].
^self selectedPreference helpString withBlanksTrimmed.!

----- Method: PreferenceBrowser>>selectedPreferenceIndex (in category 'accessing') -----
selectedPreferenceIndex
^self selectedCategoryPreferences indexOf: self selectedPreference ifAbsent: [0]!

----- Method: PreferenceBrowser>>selectedPreferenceIndex: (in category 'accessing') -----
selectedPreferenceIndex: anIndex
anIndex = 0
ifTrue: [^self].
self selectedPreference: (self selectedCategoryPreferences at: anIndex).!

----- Method: PreferenceBrowser>>stepAt:in: (in category 'stepping') -----
stepAt: millisecondClockValue in: aWindow
super stepAt: millisecondClockValue in: aWindow.
self searchPattern ~= self lastExecutedSearch
ifTrue: [self searchPreferencesFor: self searchPattern].!

----- Method: PreferenceBrowser>>themeSelected (in category 'preferences search') -----
themeSelected
preferences offerThemesMenu!

----- Method: PreferenceBrowser>>wantsStepsIn: (in category 'stepping') -----
wantsStepsIn: aWindow
^true.!

----- Method: PreferenceBrowser>>windowTitle (in category 'user interface') -----
windowTitle
^ title translated!

----- Method: Preferences class>>addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector:viewRegistry: (in category '*PreferenceBrowser') -----
addPreference: aName categories: categoryList default: aValue balloonHelp: helpString projectLocal: localBoolean changeInformee: informeeSymbol changeSelector: aChangeSelector viewRegistry: aViewRegistry
"For compatibility with the old set of protocols"
^self addPreference: aName categories: categoryList default: aValue balloonHelp: helpString projectLocal: localBoolean changeInformee: informeeSymbol changeSelector: aChangeSelector type: (PreferenceViewRegistry typeOfRegistry: aViewRegistry).!

----- Method: Preference>>representativeButtonWithColor:inPanel: (in category '*PreferenceBrowser') -----
representativeButtonWithColor: aColor inPanel: aPanel
| view |
view := self viewForPanel: aPanel.
^view ifNotNil: [view representativeButtonWithColor: aColor inPanel: aPanel]!

----- Method: Preference>>viewClassForPanel: (in category '*PreferenceBrowser') -----
viewClassForPanel: aPreferencePanel
^self viewRegistry viewClassFor: aPreferencePanel!

----- Method: Preference>>viewForPanel: (in category '*PreferenceBrowser') -----
viewForPanel: aPreferencePanel
| viewClass |
viewClass := self viewClassForPanel: aPreferencePanel.
^viewClass ifNotNil: [viewClass preference: self]!

----- Method: Preference>>viewRegistry (in category '*PreferenceBrowser') -----
viewRegistry
^PreferenceViewRegistry forType: self type!

SystemWindow subclass: #PreferenceBrowserMorph
instanceVariableNames: 'mainPanel defaultButton saveButton loadButton saveToDiskButton loadFromDiskButton themeButton helpButton preferenceList lastKeystrokeTime lastKeystrokes highlightedPreferenceButton'
classVariableNames: ''
poolDictionaries: ''
category: 'PreferenceBrowser'!

----- Method: PreferenceBrowserMorph class>>withModel: (in category 'instance creation') -----
withModel: aPreferenceBrowser
^self new initializeWithModel: aPreferenceBrowser;
yourself.!

----- Method: PreferenceBrowserMorph>>adjustPreferenceListItemsWidth (in category 'updating') -----
adjustPreferenceListItemsWidth
| panel |
self preferenceList scroller submorphs
ifEmpty: [^self].
panel := self preferenceListInnerPanel.
panel width: self preferenceList width - (self preferenceList scrollBarThickness*2).
panel submorphsDo: [:ea | ea hResizing: #rigid; width: panel width].
self preferenceList setScrollDeltas.!

----- Method: PreferenceBrowserMorph>>basicButton (in category 'submorphs - buttons') -----
basicButton
| button |
button := SimpleButtonMorph new.
button
borderWidth: 2;
borderColor: #raised;
on: #mouseEnter send: #value to: [button borderColor: self paneColor];
on: #mouseLeave send: #value to: [button borderColor: #raised];
vResizing: #spaceFill;
useRoundedCorners;
clipSubmorphs: true;
color: self paneColor muchLighter;
target: self model.
^button!

----- Method: PreferenceBrowserMorph>>basicKeyPressed: (in category 'event handling') -----
basicKeyPressed: anEvent
| aChar oldSelection nextSelection max milliSeconds nextSelectionList nextSelectionPref |
aChar := anEvent keyCharacter.
nextSelection := oldSelection := self selectedPreferenceIndex.
max := self selectedCategoryPreferences size.
milliSeconds := Time millisecondClockValue.
milliSeconds - lastKeystrokeTime > 300 ifTrue: ["just use the one current character for selecting"
lastKeystrokes := ''].
lastKeystrokes := lastKeystrokes , aChar asLowercase asString.
lastKeystrokeTime := milliSeconds.
nextSelectionList := OrderedCollection newFrom: (self selectedCategoryPreferences copyFrom: oldSelection + 1 to: max).
nextSelectionList addAll: (self selectedCategoryPreferences copyFrom: 1 to: oldSelection).
"Get rid of blanks and style used in some lists"
nextSelectionPref := nextSelectionList detect: [:a | a name withBlanksTrimmed asLowercase beginsWith: lastKeystrokes]
ifNone: [^ self preferenceList flash"match not found"].
nextSelection := self selectedCategoryPreferences findFirst: [:a | a = nextSelectionPref].
"No change if model is locked"
oldSelection == nextSelection ifTrue: [^ self preferenceList flash].
^ self selectedPreferenceIndex: nextSelection!

----- Method: PreferenceBrowserMorph>>buttonRowLayoutFrame (in category 'submorphs - buttons') -----
buttonRowLayoutFrame
^LayoutFrame fractions: (0@0 corner: 1@0) offsets: (0@0 corner: 0@ (TextStyle defaultFont height * 2.5))!

----- Method: PreferenceBrowserMorph>>defaultButton (in category 'submorphs - buttons') -----
defaultButton
^defaultButton ifNil:
[defaultButton := self basicButton
label: 'default' translated;
actionSelector: #defaultSelected;
setBalloonText:
'Click here to reset all the preferences to their standard ',
'default values.' translated]!

----- Method: PreferenceBrowserMorph>>downKeyPressed: (in category 'event handling') -----
downKeyPressed: anEvent
self selectedPreferenceIndex:
(self selectedPreferenceIndex + 1
min: self selectedCategoryPreferences size)!

----- Method: PreferenceBrowserMorph>>endKeyPressed: (in category 'event handling') -----
endKeyPressed: anEvent
self selectedPreferenceIndex: self selectedCategoryPreferences size.
!

----- Method: PreferenceBrowserMorph>>extent: (in category 'geometry') -----
extent: aPoint
super extent: aPoint.
self fullBounds.
self adjustPreferenceListItemsWidth.!

----- Method: PreferenceBrowserMorph>>helpButton (in category 'submorphs - buttons') -----
helpButton
^helpButton ifNil:
[helpButton := self basicButton
label: 'help' translated;
setBalloonText:
'Click here to get some hints on use of this Preferences ',
'Panel' translated;
actionSelector: #helpSelected]!

----- Method: PreferenceBrowserMorph>>homeKeyPressed: (in category 'event handling') -----
homeKeyPressed: anEvent
self selectedPreferenceIndex: 1.
!

----- Method: PreferenceBrowserMorph>>initializeWithModel: (in category 'initialization') -----
initializeWithModel: aPreferenceBrowser
lastKeystrokeTime := 0.
lastKeystrokes := ''.
self
model: aPreferenceBrowser;
clipSubmorphs: true;
setLabel: self model windowTitle;
name: 'PreferenceBrowser';
addMorph: self rootPanel fullFrame: self rootPanelLayoutFrame;
addMorph: self newButtonRow fullFrame: self buttonRowLayoutFrame.!

----- Method: PreferenceBrowserMorph>>keyPressed: (in category 'event handling') -----
keyPressed: anEvent
self selectedCategory
ifNil: [^self].
anEvent keyValue = 30
ifTrue: [^self upKeyPressed: anEvent].
anEvent keyValue = 31
ifTrue: [^self downKeyPressed: anEvent].
anEvent keyValue = 1
ifTrue: [^self homeKeyPressed: anEvent].
anEvent keyValue = 4
ifTrue: [^self endKeyPressed: anEvent].
anEvent keyValue = 11
ifTrue: [^self pageUpKeyPressed: anEvent].
anEvent keyValue = 12
ifTrue: [^self pageDownKeyPressed: anEvent].
self basicKeyPressed: anEvent.!

----- Method: PreferenceBrowserMorph>>loadButton (in category 'submorphs - buttons') -----
loadButton
^loadButton ifNil:
[loadButton := self basicButton
label: 'load' translated;
actionSelector: #loadSelected;
setBalloonText:
'Click here to reset all the preferences to their values ',
'in your Personal Preferences.' translated]!

----- Method: PreferenceBrowserMorph>>loadFromDiskButton (in category 'submorphs - buttons') -----
loadFromDiskButton
^loadFromDiskButton ifNil:
[loadFromDiskButton := self basicButton
label: 'load from disk' translated;
actionSelector: #loadFromDiskSelected;
setBalloonText:
'Click here to load all the preferences from ',
'their saved values on disk.' translated]!

----- Method: PreferenceBrowserMorph>>mainPanel (in category 'submorphs - main panel') -----
mainPanel
^mainPanel ifNil:
[mainPanel := Morph new
color: Color transparent;
hResizing: #spaceFill;
vResizing: #spaceFill;
cellInset: 5;
layoutPolicy: TableLayout new;
listCentering: #topLeft;
listDirection: #leftToRight;
cellPositioning: #topLeft;
clipSubmorphs: true;
on: #mouseEnter send: #paneTransition: to: self;
addMorphBack: self newCategoryListPanel;
addMorphBack: self newPreferenceListPanel;
yourself].!

----- Method: PreferenceBrowserMorph>>mouseDownOn:event: (in category 'event handling') -----
mouseDownOn: aPreferenceView event: anEvent
anEvent hand newKeyboardFocus: self preferenceList scroller.
anEvent yellowButtonPressed
ifTrue: [aPreferenceView offerPreferenceNameMenu: self model]!

----- Method: PreferenceBrowserMorph>>newButtonRow (in category 'submorphs - buttons') -----
newButtonRow
^BorderedMorph new
color: Color transparent;
cellInset: 2;
layoutInset: 2;
layoutPolicy: TableLayout new;
listDirection: #leftToRight;
listCentering: #topLeft;
cellPositioning: #topLeft;
on: #mouseEnter send: #paneTransition: to: self;
on: #mouseLeave send: #paneTransition: to: self;
addMorphBack: self defaultButton;
addMorphBack: self newSeparator;
addMorphBack: self saveButton;
addMorphBack: self loadButton;
addMorphBack: self newSeparator;
addMorphBack: self saveToDiskButton;
addMorphBack: self loadFromDiskButton;
addMorphBack: self newSeparator;
addMorphBack: self themeButton;
addMorphBack: self newTransparentFiller;
addMorphBack: self helpButton;
yourself.!

----- Method: PreferenceBrowserMorph>>newCategoryList (in category 'submorphs - category list') -----
newCategoryList
^(PluggableListMorph
on: self model
list: #categoryList
selected: #selectedCategoryIndex
changeSelected: #selectedCategoryIndex:)
color: Color white;
borderInset;
vResizing: #spaceFill;
hResizing: #rigid;
width: 150;
yourself.!

----- Method: PreferenceBrowserMorph>>newCategoryListPanel (in category 'submorphs - category list') -----
newCategoryListPanel
^Morph new
hResizing: #shrinkWrap;
vResizing: #spaceFill;
color: Color transparent;
layoutPolicy: TableLayout new;
cellInset: 3;
listCentering: #topLeft;
listDirection: #topToBottom;
cellPositioning: #topLeft;
clipSubmorphs: true;
addMorphBack: self newCategoryListPanelLabel;
addMorphBack: self newCategoryList!

----- Method: PreferenceBrowserMorph>>newCategoryListPanelLabel (in category 'submorphs - category list') -----
newCategoryListPanelLabel
^StringMorph contents: 'Categories' translated.!

----- Method: PreferenceBrowserMorph>>newPreferenceButtonFor: (in category 'submorphs - preference list') -----
newPreferenceButtonFor: aPreference
| button |
button := PBPreferenceButtonMorph preference: aPreference model: self model.
button
on: #mouseDown
send: #value:
to:
[:anEvent |
self
selectedPreference: aPreference;
mouseDownOn: button preferenceView event: anEvent].
^button!

----- Method: PreferenceBrowserMorph>>newPreferenceListInnerPanel (in category 'submorphs - preference list') -----
newPreferenceListInnerPanel
| panel maxWidth totalHeight |
panel := (Morph new)
color: Color transparent;
layoutPolicy: TableLayout new;
listDirection: #topToBottom;
cellPositioning: #topLeft;
yourself.
self selectedCategoryPreferences
do: [:aPref | panel addMorphBack: (self newPreferenceButtonFor: aPref)].
panel submorphs size = 0 ifTrue: [^panel].
maxWidth := (panel submorphs detectMax: [:m | m width]) width.
panel width: maxWidth.
totalHeight := (panel submorphs collect: [:ea | ea height]) inject: 0
into: [:h :tot | h + tot].
panel height: totalHeight.
panel fullBounds.
^panel!

----- Method: PreferenceBrowserMorph>>newPreferenceListPanel (in category 'submorphs - preference list') -----
newPreferenceListPanel
| panel |
panel := Morph new
hResizing: #spaceFill;
vResizing: #spaceFill;
color: Color transparent;
layoutPolicy: TableLayout new;
cellInset: 3;
listCentering: #topLeft;
listDirection: #topToBottom;
cellPositioning: #topLeft;
clipSubmorphs: true;
addMorphBack: self newPreferenceListPanelLabel;
addMorphBack: self preferenceList.
^panel.!

----- Method: PreferenceBrowserMorph>>newPreferenceListPanelLabel (in category 'submorphs - preference list') -----
newPreferenceListPanelLabel
^StringMorph contents: 'Preferences' translated.!

----- Method: PreferenceBrowserMorph>>newSearchButton (in category 'submorphs - search panel') -----
newSearchButton
^self basicButton
label: 'search' translated;
actionSelector: #searchSelected;
setBalloonText:
'Type what you want to search for here, then hit ',
'the "Search" button, or else hit RETURN or ENTER' translated.!

----- Method: PreferenceBrowserMorph>>newSearchPanel (in category 'submorphs - search panel') -----
newSearchPanel
| bottom |
bottom := Morph new
color: Color transparent;
cellInset: 5;
layoutPolicy: TableLayout new;
listDirection: #leftToRight;
listCentering: #topLeft;
cellPositioning: #topLeft;
hResizing: #spaceFill;
vResizing: #shrinkWrap;
addMorphBack: self newSearchTextField
yourself.
^Morph new
color: Color transparent;
layoutPolicy: TableLayout new;
listDirection: #topToBottom;
listCentering: #topLeft;
cellPositioning: #topLeft;
hResizing: #spaceFill;
vResizing: #shrinkWrap;
cellInset: 3;
addMorphBack: (StringMorph contents: 'Search preferences for: ');
addMorphBack: bottom;
yourself.!

----- Method: PreferenceBrowserMorph>>newSearchTextField (in category 'submorphs - search panel') -----
newSearchTextField
| ptm |
ptm := PluggableTextMorph
on: self model
text: #searchPattern
accept: #searchPattern:.
ptm
hideVScrollBarIndefinitely: true;
borderInset;
color: Color white;
vResizing: #rigid;
hResizing: #spaceFill;
height: TextStyle defaultFont height * 2;
acceptOnCR: true;
onKeyStrokeSend: #value to: [ptm hasUnacceptedEdits ifTrue: [ptm accept]].
^ptm.!

----- Method: PreferenceBrowserMorph>>newSeparator (in category 'submorphs - buttons') -----
newSeparator
^BorderedMorph new
borderWidth: 2;
borderColor: Color transparent;
color: self paneColor;
hResizing: #rigid;
width: 5;
vResizing: #spaceFill;
yourself!

----- Method: PreferenceBrowserMorph>>newTransparentFiller (in category 'submorphs - buttons') -----
newTransparentFiller
^Morph new
color: Color transparent;
vResizing: #spaceFill;
hResizing: #spaceFill;
yourself.!

----- Method: PreferenceBrowserMorph>>pageDownKeyPressed: (in category 'event handling') -----
pageDownKeyPressed: anEvent
self selectedPreferenceIndex: (self selectedPreferenceIndex + self preferencesShowing size min: self selectedCategoryPreferences size).
!

----- Method: PreferenceBrowserMorph>>pageUpKeyPressed: (in category 'event handling') -----
pageUpKeyPressed: anEvent
self selectedPreferenceIndex: (self selectedPreferenceIndex - self preferencesShowing size max: 1).
!

----- Method: PreferenceBrowserMorph>>preferenceList (in category 'submorphs - preference list') -----
preferenceList
^preferenceList ifNil:
[preferenceList := ScrollPane new
color: Color white;
borderInset;
vResizing: #spaceFill;
hResizing: #spaceFill.
preferenceList scroller
on: #mouseEnter send: #value:
to: [:event | event hand newKeyboardFocus: preferenceList scroller];
on: #keyStroke send: #keyPressed: to: self.
preferenceList.]!

----- Method: PreferenceBrowserMorph>>preferenceListInnerPanel (in category 'submorphs - preference list') -----
preferenceListInnerPanel
^self preferenceList scroller submorphs first!

----- Method: PreferenceBrowserMorph>>preferencesShowing (in category 'submorphs - preference list') -----
preferencesShowing
| prefs |
prefs := self preferenceListInnerPanel submorphs
copyFrom: (self selectedPreferenceIndex max: 1)
to: self selectedCategoryPreferences size.
^prefs reject: [:ea | (ea top - prefs first top) > self preferenceList scroller height].!

----- Method: PreferenceBrowserMorph>>rootPanel (in category 'submorphs - root panel') -----
rootPanel
^BorderedMorph new
color: Color transparent;
layoutInset: 10;
cellInset: 10;
layoutPolicy: TableLayout new;
listDirection: #topToBottom;
listCentering: #topLeft;
cellPositioning: #topLeft;
addMorphBack: self newSearchPanel;
addMorphBack: self mainPanel;
yourself.!

----- Method: PreferenceBrowserMorph>>rootPanelLayoutFrame (in category 'submorphs - root panel') -----
rootPanelLayoutFrame
| frame |
frame := self buttonRowLayoutFrame.
^LayoutFrame fractions: (0@0 corner: 1@1) offsets: (0@(frame bottomOffset) corner: 0@0)!

----- Method: PreferenceBrowserMorph>>saveButton (in category 'submorphs - buttons') -----
saveButton
^saveButton ifNil:
[saveButton := self basicButton
label: 'save' translated;
actionSelector: #saveSelected;
setBalloonText:
'Click here to save the current constellation of Preferences ',
'settings as your personal defaults; you can get them all ',
'reinstalled with a single gesture by clicking the "Restore ',
'my Personal Preferences".' translated]!

----- Method: PreferenceBrowserMorph>>saveToDiskButton (in category 'submorphs - buttons') -----
saveToDiskButton
^saveToDiskButton ifNil:
[saveToDiskButton := self basicButton
label: 'save to disk' translated;
actionSelector: #saveToDiskSelected;
setBalloonText:
'Click here to save the current constellation of Preferences ',
'settings to a file; you can get them all reinstalled with a ',
'single gesture by clicking "Restore Settings From Disk".'
translated]!

----- Method: PreferenceBrowserMorph>>selectedCategory (in category 'model access') -----
selectedCategory
^self model selectedCategory!

----- Method: PreferenceBrowserMorph>>selectedCategoryIndex (in category 'model access') -----
selectedCategoryIndex
^self model selectedCategoryIndex!

----- Method: PreferenceBrowserMorph>>selectedCategoryIndex: (in category 'model access') -----
selectedCategoryIndex: anIndex
^self model selectedCategoryIndex: anIndex!

----- Method: PreferenceBrowserMorph>>selectedCategoryPreferences (in category 'model access') -----
selectedCategoryPreferences
^self model selectedCategoryPreferences!

----- Method: PreferenceBrowserMorph>>selectedPreference (in category 'model access') -----
selectedPreference
^self model selectedPreference!

----- Method: PreferenceBrowserMorph>>selectedPreference: (in category 'model access') -----
selectedPreference: aPreference
^self model selectedPreference: aPreference!

----- Method: PreferenceBrowserMorph>>selectedPreferenceButton (in category 'submorphs - preference list') -----
selectedPreferenceButton
^(self preferenceListInnerPanel submorphs at: self selectedPreferenceIndex)!

----- Method: PreferenceBrowserMorph>>selectedPreferenceIndex (in category 'model access') -----
selectedPreferenceIndex
^self model selectedPreferenceIndex!

----- Method: PreferenceBrowserMorph>>selectedPreferenceIndex: (in category 'model access') -----
selectedPreferenceIndex: anIndex
^self model selectedPreferenceIndex: anIndex!

----- Method: PreferenceBrowserMorph>>themeButton (in category 'submorphs - buttons') -----
themeButton
^themeButton ifNil:
[themeButton := self basicButton
label: 'theme...' translated;
actionSelector: #themeSelected;
setBalloonText:
'Numerous "Preferences" govern many things about the ',
'way Squeak looks and behaves. Set individual preferences ',
'using a "Preferences" panel. Set an entire "theme" of many ',
'Preferences all at the same time by pressing this "change ',
'theme" button and choosing a theme to install. Look in ',
'category "themes" in Preferences class to see what each ',
'theme does; add your own methods to the "themes" ',
'category and they will show up in the list of theme ',
'choices.' translated].!

----- Method: PreferenceBrowserMorph>>turnOffSelectedPreference (in category 'submorphs - preference list') -----
turnOffSelectedPreference
highlightedPreferenceButton
ifNil: [^self].
highlightedPreferenceButton highlightOff.
highlightedPreferenceButton := nil.!

----- Method: PreferenceBrowserMorph>>turnOnSelectedPreference (in category 'submorphs - preference list') -----
turnOnSelectedPreference
highlightedPreferenceButton
ifNotNilDo: [:m | m highlightOff].
highlightedPreferenceButton := self selectedPreferenceButton
highlightOn;
yourself.
self preferenceList scrollToShow: highlightedPreferenceButton bounds.!

----- Method: PreferenceBrowserMorph>>upKeyPressed: (in category 'event handling') -----
upKeyPressed: anEvent
self selectedPreferenceIndex:
(self selectedPreferenceIndex - 1 max: 1).
!

----- Method: PreferenceBrowserMorph>>update: (in category 'updating') -----
update: aSymbol
super update: aSymbol.
aSymbol == #selectedPreference
ifTrue: [self updateSelectedPreference].
aSymbol == #selectedCategoryIndex
ifTrue: [self updateSelectedCategoryPreferences].!

----- Method: PreferenceBrowserMorph>>updateSelectedCategoryPreferences (in category 'updating') -----
updateSelectedCategoryPreferences
Cursor wait showWhile:
[self preferenceList
hScrollBarValue: 0;
vScrollBarValue: 0.
self preferenceList scroller removeAllMorphs.
self preferenceList scroller addMorphBack: self newPreferenceListInnerPanel.
self adjustPreferenceListItemsWidth]!

----- Method: PreferenceBrowserMorph>>updateSelectedPreference (in category 'updating') -----
updateSelectedPreference
| index |
self selectedCategory ifNotNil: [self turnOffSelectedPreference].
index := self selectedPreferenceIndex.
index = 0
ifTrue: [^self].
self turnOnSelectedPreference.!