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

commits at source.squeak.org commits at source.squeak.org
Tue Oct 6 17:37:03 UTC 2009


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 at 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 at 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 at 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 at 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 at 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 at 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 at 0 corner: 1 at 0) offsets: (0 at 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 at 0 corner: 1 at 1) offsets: (0@(frame bottomOffset) corner: 0 at 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.!




More information about the Squeak-dev mailing list