[Cuis-dev] PreferenceBrowser tool

Wed Jun 14 17:28:17 PDT 2023

El 14/6/23 a las 21:18, Mariano Montone escribió:
>
> Hi,
>
>     I'd like to present this tool for your consideration for including 
> in Cuis (not necessarily in Core, perhaps as extra package).
>
> It is a browser for system preferences.
>
> It features:
>
> - Browse by category.
>
> - Filter by name.
>
> - Custom widgets for editing Booleans, Strings, Fonts, Options.
>
> - Inspect and browse references of a preference (right click on 
> preference).
>
> It is an standalone package (doesn't depend on other packages).
>
> To try, load the package, then open via World Menu -> Preferences -> 
> All preferences ..
>
I attach another version with some cleanups and less agressive colors.

    Mariano
-------------- next part --------------
'From Cuis 6.0 [latest update: #5861] on 14 June 2023 at 9:25:10 pm'!
'Description Tool for browsing and editing Cuis preferences.'!
!provides: 'PreferenceBrowser' 1 57!
SystemOrganization addCategory: 'PreferenceBrowser'!

!classDefinition: #PreferenceEditorMorph category: 'PreferenceBrowser'!
LayoutMorph subclass: #PreferenceEditorMorph
	instanceVariableNames: 'preference'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PreferenceBrowser'!
!classDefinition: 'PreferenceEditorMorph class' category: 'PreferenceBrowser'!
PreferenceEditorMorph class
	instanceVariableNames: ''!

!classDefinition: #PreferencesPanel category: 'PreferenceBrowser'!
LayoutMorph subclass: #PreferencesPanel
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PreferenceBrowser'!
!classDefinition: 'PreferencesPanel class' category: 'PreferenceBrowser'!
PreferencesPanel class
	instanceVariableNames: ''!

!classDefinition: #PreferenceButtonMorph category: 'PreferenceBrowser'!
PluggableButtonMorph subclass: #PreferenceButtonMorph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PreferenceBrowser'!
!classDefinition: 'PreferenceButtonMorph class' category: 'PreferenceBrowser'!
PreferenceButtonMorph class
	instanceVariableNames: ''!

!classDefinition: #PreferenceBrowser category: 'PreferenceBrowser'!
SystemWindow subclass: #PreferenceBrowser
	instanceVariableNames: 'categoriesList selectedCategory selectedPreference preferencesPane scroller categories filter'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PreferenceBrowser'!
!classDefinition: 'PreferenceBrowser class' category: 'PreferenceBrowser'!
PreferenceBrowser class
	instanceVariableNames: ''!

!classDefinition: #PreferenceSelectionButtonMorph category: 'PreferenceBrowser'!
BoxedMorph subclass: #PreferenceSelectionButtonMorph
	instanceVariableNames: 'elems model placeHolder button printer getter setter selectionStrategy'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PreferenceBrowser'!
!classDefinition: 'PreferenceSelectionButtonMorph class' category: 'PreferenceBrowser'!
PreferenceSelectionButtonMorph class
	instanceVariableNames: ''!

!classDefinition: #PreferenceToggleButtonMorph category: 'PreferenceBrowser'!
BoxedMorph subclass: #PreferenceToggleButtonMorph
	instanceVariableNames: 'model getStateSelector isPressed actWhen actionSelector'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PreferenceBrowser'!
!classDefinition: 'PreferenceToggleButtonMorph class' category: 'PreferenceBrowser'!
PreferenceToggleButtonMorph class
	instanceVariableNames: ''!

!PreferenceEditorMorph commentStamp: '<historical>' prior: 0!
The editor row for a single preference!

!PreferenceBrowser commentStamp: '<historical>' prior: 0!
Cuis Smalltalk preferences editor.

PreferenceBrowser open.!

!PreferenceSelectionButtonMorph commentStamp: '<historical>' prior: 0!
Button morph that opens a selection menu for selecting a value.

See examples in class side.

Structure:
 model Object -- The object that holds the selected value.
 elems Collection -- The collection of elements to choose from.
 printer Symbol|Block -- Block or Symbol with which to print the elements to choose from.
 getter Symbol -- Selector to use on the model for getting its value. Default is #value.
 setter Symbol -- Selector to use on the model for setting its value. Default is #value:.
 selectionStrategy Number|Symbol -- When #menu, a MenuMorph is used for selecting values.
                                                          When #list, a LIstSelectionMorph is used for selecting values.
                                                          When a Number, a MenuMorph is used if elems size is <= that number, and a ListSelectionMorph if elems size > that number.
                                                          Default is number with value 20.!

!PreferenceEditorMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 19:06:15'!
evaluatePreferenceValue

	| input |

	input := FillInTheBlankMorph 
					request: 'Preference value (evaluate and set)' 
					initialAnswer: preference value printString
					onCancel: #cancelPreferenceValue.

	(input = #cancelPreferenceValue) ifFalse: [ | val |
		val  := Compiler evaluate: input.
		self setPreferenceTo: val.
		self changed: preference. "Trick to update PluggableButtons"
		]! !

!PreferenceEditorMorph methodsFor: 'as yet unclassified' stamp: 'MM 7/21/2016 16:43'!
handlesMouseDown: aMouseEvent
	^ true! !

!PreferenceEditorMorph methodsFor: 'as yet unclassified' stamp: 'MM 7/21/2016 16:53'!
handlesMouseOver: aMouseEvent
	^ true! !

!PreferenceEditorMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/13/2023 19:43:37'!
initialize: aPreference

	| preferenceName nameMorph |

	preference := aPreference.

	self color: Color white.
	preferenceName := self printSymbol: aPreference name.
	self setBalloonText: aPreference description.
	nameMorph := LabelMorph contents: preferenceName.
	self addMorph: nameMorph
		proportionalWidth: 0.95;
		addMorph: (	self widgetForPreference: aPreference)! !

!PreferenceEditorMorph methodsFor: 'as yet unclassified' stamp: 'MM 7/21/2016 18:18'!
inspectPreference
	preference inspect! !

!PreferenceEditorMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/13/2023 21:39:41'!
mouseButton2Activity

	self openPreferenceMenu! !

!PreferenceEditorMorph methodsFor: 'as yet unclassified' stamp: 'MM 7/21/2016 17:10'!
mouseEnter: aMouseEvent
	self color: (Color r: 0.942 g: 0.942 b: 0.942).! !

!PreferenceEditorMorph methodsFor: 'as yet unclassified' stamp: 'MM 7/21/2016 17:08'!
mouseLeave: aMouseEvent
	self color: Color white.! !

!PreferenceEditorMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/13/2023 21:43:37'!
openPreferenceMenu

	| menu |

	menu := MenuMorph new defaultTarget: self; yourself.

	menu addTitle: ((self printSymbol: preference name) squeezedTo: 30).

	"menu add: 'Set default (', (preference defaultValue printString), ')'
		    target: self
		    action: #setDefault."

	menu add: 'Set value'
		    target: self
		    action: #evaluatePreferenceValue.

	menu add: 'Inspect'
		     target: self
			action: #inspectPreference.

	menu add: 'Browse references' 
		target: [Smalltalk browseAllCallsOn: preference name]
		action: #value.		

	(preference description isNil not and: [
		preference description isEmpty not]) ifTrue: [
		menu addMorphBack: (TextModelMorph withText: preference description)].

	menu popUpInWorld: self world! !

!PreferenceEditorMorph methodsFor: 'as yet unclassified' stamp: 'MM 7/21/2016 16:25'!
printSymbol: aSymbol
	| stream printed |
	stream _ aSymbol string readStream.
	printed _ WriteStream on: ''.
	printed nextPut: stream next asUppercase.
	[ stream atEnd ] whileFalse: [ | char |
		char _ stream next.
		char isUppercase ifTrue: [
			printed nextPut: Character space.
			char _ char asLowercase ].
		printed nextPut: char ].
	^ printed contents.! !

!PreferenceEditorMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 18:34:54'!
realTypeOfPreference: aPreference

	(aPreference type = BlockClosure) ifTrue: [^ aPreference value class].
	^ aPreference type! !

!PreferenceEditorMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 19:04:19'!
requestString

	self request: 'String:' initialAnswer: preference value 
		do: [:answer | self setPreference: preference to: answer.
					self changed: preference "Update Button morph"
					]! !

!PreferenceEditorMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 18:37:51'!
setPreference: aPreference to: anObject

	aPreference value: 
		((aPreference type = BlockClosure) 
			ifTrue: [	[anObject]]
			ifFalse: [anObject]) ! !

!PreferenceEditorMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 18:38:37'!
setPreferenceTo: anObject

	preference value: 
		((preference type = BlockClosure) 
			ifTrue: [	[anObject]]
			ifFalse: [anObject]) ! !

!PreferenceEditorMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:46:35'!
widgetForBooleanPreference: aPreference label: aLabel

	|model|

	model := Switch new
		onAction: [ self setPreferenceTo: true ];
		offAction: [ self setPreferenceTo: false ];
		yourself.
	aPreference value
		ifTrue: [ model turnOn ]
		ifFalse: [ model turnOff ].
	^ PreferenceToggleButtonMorph
		model: model
		stateGetter: #isOn
		action: #switch	! !

!PreferenceEditorMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 16:48:21'!
widgetForDefaultPreference: aPreference label: aLabel

	| widget |
	widget := PreferenceButtonMorph 
					model: self 
					action: #evaluatePreferenceValue  
					label: aLabel .
	widget setBalloonText: preference value printString.
	widget fitContents.

	^ widget! !

!PreferenceEditorMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 19:09:24'!
widgetForFontPreference: aPreference label: aLabel

	^ PreferenceButtonMorph 
		model: [| fontFamily |
			fontFamily := FontFamily promptUser.
			fontFamily ifNotNil: [
				self request:  'Point size' do: [:pointSizeStr | 
					self setPreference: aPreference to: (fontFamily atPointSize: pointSizeStr asNumber)]	]]
		action: #value
		label: aLabel

	! !

!PreferenceEditorMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:50:47'!
widgetForOptionsPreference: aPreference label: aLabel

	^ PreferenceSelectionButtonMorph on: aPreference elems: aPreference type! !

!PreferenceEditorMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 19:01:41'!
widgetForPreference: aPreference

	| valString preferenceType |

	valString := preference value printString truncateWithElipsisTo: 20.
	preferenceType := self realTypeOfPreference: aPreference.

	"Booleans"	
	(preferenceType = Boolean) ifTrue: [ ^ self widgetForBooleanPreference: aPreference	 label: valString].

	"Array with options"	
	(preferenceType isArray) ifTrue: [^ self widgetForOptionsPreference: aPreference label: valString].

	"Strings"	
	((preferenceType = CharacterSequence) or: [preferenceType inheritsFrom: CharacterSequence]) 
		ifTrue: [^ self widgetForStringPreference: aPreference label: valString		].	

	"Fonts"
	((preferenceType = AbstractFont) or: [aPreference type inheritsFrom: AbstractFont])
		ifTrue: [^ self widgetForFontPreference: aPreference label: valString].

	"Otherwise, create a button for evaluating a Smalltalk expression and setting the preference value with the result."
	^ self widgetForDefaultPreference: aPreference label: valString! !

!PreferenceEditorMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 19:03:32'!
widgetForStringPreference: aPreference label: aLabel

	^ PreferenceButtonMorph
			model: self
			action: #requestString
			label: aLabel! !

!PreferenceEditorMorph class methodsFor: 'as yet unclassified' stamp: 'MM 7/21/2016 16:23'!
on: aPreference
	^ self newRow initialize: aPreference.! !

!PreferencesPanel methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 11:07:59'!
adjustExtent

	self morphWidth: owner morphWidth! !

!PreferenceButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/13/2023 19:55:20'!
fitContents

	^ self morphExtent: `0 at 0`! !

!PreferenceButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 15:11:39'!
fontToUse

	^ FontFamily defaultFamilyPointSize: FontFamily defaultPointSize - 1! !

!PreferenceButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/13/2023 19:54:12'!
measureContents
	| f |
	f := self fontToUse.
	^((f widthOfString: label) max: 3)  @ f lineSpacing! !

!PreferenceButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 15:11:14'!
minimumExtent

	^ self measureContents + self extentBorder + (10 at 6)! !

!PreferenceButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 18:51:30'!
update: updated

	(updated isKindOf: Preference)
		ifTrue: [
			label := updated value printString.
			^ self redrawNeeded].

	^ super update: updated! !

!PreferenceBrowser methodsFor: 'GUI building' stamp: 'MM 7/21/2016 16:23'!
buildPreferenceEditorFor: aPreference
	^ PreferenceEditorMorph on: aPreference! !

!PreferenceBrowser methodsFor: 'GUI building' stamp: 'MM 6/14/2023 11:08:30'!
buildPreferenceEditorsPane
	preferencesPane := PreferencesPanel newColumn.
	"preferencesPane color: Color white."
	self buildPreferencesPane.
	scroller := PluggableScrollPane new.
	scroller scroller: preferencesPane.
	scroller color: Color white.
	scroller scroller color: Color white.
	scroller setScrollDeltas.
	^ scroller.! !

!PreferenceBrowser methodsFor: 'GUI building' stamp: 'MM 6/14/2023 10:21:52'!
buildPreferencesPane
	preferencesPane axisEdgeWeight: 0.
	self selectedCategoryPreferences do: [ :aPreference |
		preferencesPane
			addMorph: (self buildPreferenceEditorFor: aPreference)
			fixedHeight: 20 ].

	^ preferencesPane.! !

!PreferenceBrowser methodsFor: 'GUI building' stamp: 'MM 6/14/2023 10:24:07'!
updatePreferencesList

	preferencesPane removeAllMorphs.
	self buildPreferencesPane.
	scroller scroller morphHeight: (self selectedCategoryPreferences size * 20).
	scroller setScrollDeltas.! !

!PreferenceBrowser methodsFor: 'as yet unclassified' stamp: 'MM 11/1/2018 11:32'!
categories
	^ #(#'-- all --') , (categories ifNil: [categories := Preferences categories. categories])! !

!PreferenceBrowser methodsFor: 'as yet unclassified' stamp: 'MM 7/21/2016 17:51'!
initialExtent
	^  552.0 at 389.0! !

!PreferenceBrowser methodsFor: 'as yet unclassified' stamp: 'MM 7/21/2016 17:47'!
minimumExtent
	^  546.0 at 163.0! !

!PreferenceBrowser methodsFor: 'as yet unclassified' stamp: 'MM 11/4/2022 10:52:40'!
preferences
	^ Preferences allPreferences! !

!PreferenceBrowser methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 15:01:51'!
preferencesInCategory: aCategory

	^ self preferences select: [:aPreference | aPreference category = aCategory]! !

!PreferenceBrowser methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 15:02:39'!
selectedCategoryPreferences

	|preferences|

	preferences := (self selectedCategory == #'-- all --') 
		ifTrue: [self preferences]	
		ifFalse: [self preferencesInCategory: self selectedCategory].

	filter ifNotEmpty: [
		preferences := preferences select: [:p | p name asString includesSubstring: filter asString caseSensitive: false]].

	preferences := preferences sorted: [:p1 :p2 | p1 name < p2 name].

	^ preferences! !

!PreferenceBrowser methodsFor: 'accessing' stamp: 'MM 7/21/2016 12:16'!
categoriesList
	"Answer the value of categoriesList"

	^ categoriesList! !

!PreferenceBrowser methodsFor: 'accessing' stamp: 'MM 7/21/2016 12:16'!
categoriesList: anObject
	"Set the value of categoriesList"

	categoriesList _ anObject! !

!PreferenceBrowser methodsFor: 'accessing' stamp: 'MM 11/1/2018 11:51'!
filter

	^ filter! !

!PreferenceBrowser methodsFor: 'accessing' stamp: 'MM 11/1/2018 12:17'!
filter: aText

	filter _ aText.

	self changed: #clearUserEdits.
	self updatePreferencesList ! !

!PreferenceBrowser methodsFor: 'accessing' stamp: 'MM 7/21/2016 12:16'!
selectedCategory
	"Answer the value of selectedCategory"

	^ selectedCategory! !

!PreferenceBrowser methodsFor: 'accessing' stamp: 'MM 11/1/2018 12:13'!
selectedCategory: anObject
	"Set the value of selectedCategory"
	selectedCategory _ anObject.

	self updatePreferencesList.! !

!PreferenceBrowser methodsFor: 'accessing' stamp: 'MM 7/21/2016 12:16'!
selectedPreference
	"Answer the value of selectedPreference"

	^ selectedPreference! !

!PreferenceBrowser methodsFor: 'accessing' stamp: 'MM 7/21/2016 12:16'!
selectedPreference: anObject
	"Set the value of selectedPreference"

	selectedPreference _ anObject! !

!PreferenceBrowser methodsFor: 'initialization' stamp: 'MM 6/14/2023 14:59:05'!
initialize

	| row leftPane filterInput |

	super initialize.
	self setLabel: 'Preferences'.
	selectedCategory := self categories first.
	filter := ''.

	row := LayoutMorph newRow.

	leftPane := LayoutMorph newColumn.
	leftPane axisEdgeWeight: 0.

	categoriesList := PluggableListMorphByItem
		model: self
		listGetter: #categories
		indexGetter: #selectedCategory
		indexSetter: #selectedCategory:.

	leftPane addMorphUseAll: categoriesList.

	filterInput := 	(TextModelMorph
						textProvider: self
						textGetter: #filter
						textSetter: #filter:) 
						acceptOnCR: true;
						hideScrollBarsIndefinitely;
						borderWidth: 1;
						setBalloonText: 'Preferences filter';
						yourself.
	leftPane addMorph: filterInput layoutSpec: (LayoutSpec proportionalWidth: 1 fixedHeight: 15).

	row
		addMorph: leftPane
		proportionalWidth: 0.3.
	row addAdjusterAndMorph:  self buildPreferenceEditorsPane layoutSpec: LayoutSpec useAll.
	self addMorph: row.! !

!PreferenceBrowser class methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 19:33:13'!
initialize

	"This is a fix to Cuis core. Should be moved to core, and removed from here."
	Preferences at: #classFinder put:  [ [BrowserWindow findClass] ].! !

!PreferenceBrowser class methodsFor: 'as yet unclassified' stamp: 'MM 6/13/2023 19:33:42'!
open

	"self open"

	self new openInWorld! !

!PreferenceSelectionButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:49:34'!
button
	"Answer the value of button"

	^ button! !

!PreferenceSelectionButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:49:34'!
button: anObject
	"Set the value of button"

	button _ anObject! !

!PreferenceSelectionButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:49:34'!
elems
	"Answer the value of elems"

	^ elems isBlock ifTrue: [elems value]
		ifFalse: [elems]! !

!PreferenceSelectionButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:49:34'!
elems: anObject
	"Set the value of elems"

	elems _ anObject! !

!PreferenceSelectionButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:49:34'!
getter
	"Answer the value of getter"

	^ getter! !

!PreferenceSelectionButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:49:34'!
getter: anObject
	"Set the value of getter"

	getter _ anObject! !

!PreferenceSelectionButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:49:34'!
model
	"Answer the value of model"

	^ model! !

!PreferenceSelectionButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:49:34'!
model: anObject
	"Set the value of model"

	model _ anObject! !

!PreferenceSelectionButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:49:34'!
placeHolder
	"Answer the value of placeHolder"

	^ placeHolder! !

!PreferenceSelectionButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:49:34'!
placeHolder: anObject
	"Set the value of placeHolder"

	placeHolder _ anObject! !

!PreferenceSelectionButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:49:34'!
printer
	"Answer the value of printer"

	^ printer! !

!PreferenceSelectionButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:49:35'!
printer: anObject
	"Set the value of printer"

	printer _ anObject! !

!PreferenceSelectionButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:49:35'!
selectionStrategy
	"Answer the value of selectionStrategy"

	^ selectionStrategy! !

!PreferenceSelectionButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:49:35'!
selectionStrategy: anObject
	"Set the value of selectionStrategy"

	selectionStrategy _ anObject! !

!PreferenceSelectionButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:49:35'!
setter
	"Answer the value of setter"

	^ setter! !

!PreferenceSelectionButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:49:35'!
setter: anObject
	"Set the value of setter"

	setter _ anObject! !

!PreferenceSelectionButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:49:35'!
color: aColor
	button color: aColor! !

!PreferenceSelectionButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:49:35'!
drawOn: aCavas

	"do nothing"! !

!PreferenceSelectionButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:49:35'!
fontToUse
	^ FontFamily defaultFamilyAndPointSize! !

!PreferenceSelectionButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:49:35'!
initialize: aModel getter: getSymbol setter: setSymbol elems: aCollection printer: aSymbol

	| label |

	model := aModel.
	placeHolder := '--'.
	button _ PluggableButtonMorph new model: self.
	printer := aSymbol.
	elems := aCollection.
	getter _ getSymbol.
	setter _ setSymbol.
	selectionStrategy _ 20.

	label := self value ifNil: [placeHolder] ifNotNil: [self value perform: printer].

	button label: label;
			action: #selectItem;
			color: Color lightGray;
			morphExtent: self measureContents.

	self addMorph: button.
	self morphExtent: button morphExtent.! !

!PreferenceSelectionButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:49:35'!
layoutSubmorphs
	self submorphsDo: [:m | m morphExtent: self morphExtent]! !

!PreferenceSelectionButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:49:35'!
measureContents

	| f label |

	label := self value ifNil: [placeHolder] ifNotNil: [self value perform: printer].
	f _ self fontToUse.
	^((f widthOfString: label) + 10) @ (f lineSpacing + 10).! !

!PreferenceSelectionButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:49:35'!
minimumExtent
	^ self measureContents! !

!PreferenceSelectionButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:49:35'!
morphExtent
	^ self minimumExtent! !

!PreferenceSelectionButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:55:27'!
selectItem
	^ self selectItemWithMenu! !

!PreferenceSelectionButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:49:35'!
selectItem: item

	self value: item.
	self update.
	self 
		triggerEvent: #itemSelected:
		with: item! !

!PreferenceSelectionButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:49:35'!
selectItemWithMenu

	| item menu |

	(self elems collect:[:elem | elem perform: printer]) ifNotEmpty: [:labelList |
		menu := self selectionMenuClass labelList: labelList selections: self elems .
		item := menu startUpMenu.

		item ifNotNil: [		self selectItem: item ]]
		! !

!PreferenceSelectionButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:49:35'!
selectionMenuClass
	^ SelectionMenu! !

!PreferenceSelectionButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:49:35'!
someSubmorphPositionOrExtentChanged
	"Our extent, or some submorph changed. Must layout submorphs again."
	super someSubmorphPositionOrExtentChanged .

	button morphExtent ifNotNil: [
		self morphExtent: button morphExtent]! !

!PreferenceSelectionButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:49:35'!
update

	button label: (self value perform: printer).
	self morphExtent: 0 at 0.
	self redrawNeeded.
	self owner ifNotNil: [:o | o someSubmorphPositionOrExtentChanged]  ! !

!PreferenceSelectionButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:49:35'!
value
	^ self model perform: getter! !

!PreferenceSelectionButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:49:35'!
value: anObject
	self model perform: setter with: anObject! !

!PreferenceSelectionButtonMorph class methodsFor: 'instance creation' stamp: 'MM 6/14/2023 20:56:24'!
on: aModel 
	^ self
		on: aModel
		elems: #()
		printer: #asString.! !

!PreferenceSelectionButtonMorph class methodsFor: 'instance creation' stamp: 'MM 6/14/2023 20:56:28'!
on: aModel elems: aCollection
	^ self
		on: aModel
		elems: aCollection
		printer: #asString.! !

!PreferenceSelectionButtonMorph class methodsFor: 'instance creation' stamp: 'MM 6/14/2023 20:49:35'!
on: aModel elems: aCollection printer: aSymbol
	"(SelectionButtonMorph on: (ValueHolder value: #foo))
	elems: #(foo bar baz);
	color: Color lightGray ;
	openInWorld"
	^ self on: aModel getter: #value setter: #value: elems: aCollection printer: aSymbol! !

!PreferenceSelectionButtonMorph class methodsFor: 'instance creation' stamp: 'MM 6/14/2023 20:49:35'!
on: aModel getter: getter setter: setter elems: aCollection printer: aSymbol
	"(SelectionButtonMorph on: (ValueHolder value: #foo))
	elems: #(foo bar baz);
	color: Color lightGray ;
	openInWorld"
	^ self new initialize: aModel getter: getter setter: setter elems: aCollection printer: aSymbol! !

!PreferenceToggleButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:45:06'!
actWhen
	"Answer the value of actWhen"

	^ actWhen! !

!PreferenceToggleButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:45:06'!
actWhen: anObject
	"Set the value of actWhen"

	actWhen _ anObject! !

!PreferenceToggleButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:45:06'!
actionSelector
	"Answer the value of actionSelector"

	^ actionSelector! !

!PreferenceToggleButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:45:06'!
actionSelector: anObject
	"Set the value of actionSelector"

	actionSelector _ anObject! !

!PreferenceToggleButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:45:06'!
getStateSelector
	"Answer the value of getStateSelector"

	^ getStateSelector! !

!PreferenceToggleButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:45:06'!
getStateSelector: anObject
	"Set the value of getStateSelector"

	getStateSelector _ anObject! !

!PreferenceToggleButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:48:42'!
initialize
	super initialize.

	getStateSelector := #value.
	self morphExtent: 34 at 20.
	color := Color white.
	actWhen := #buttonDown.
	extent := nil! !

!PreferenceToggleButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:45:06'!
isPressed
	"Answer the value of isPressed"

	^ isPressed! !

!PreferenceToggleButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:45:06'!
isPressed: anObject
	"Set the value of isPressed"

	isPressed _ anObject! !

!PreferenceToggleButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:45:06'!
model
	"Answer the value of model"

	^ model! !

!PreferenceToggleButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:45:06'!
model: anObject
	"Set the value of model"

	model ifNotNil: [model removeDependent: self].
	getStateSelector ifNotNil: [
		anObject ifNotNil: [anObject addDependent: self]].
	model _ anObject! !

!PreferenceToggleButtonMorph methodsFor: 'accessing' stamp: 'MM 6/14/2023 20:45:06'!
update: aSymbol

	super update: aSymbol.
	aSymbol = getStateSelector ifTrue: [
		self redrawNeeded ]! !

!PreferenceToggleButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:45:06'!
defaultExtent

	^ 30 at 16! !

!PreferenceToggleButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 21:23:43'!
drawOn: aCanvas

	|rx ry statusColor |

	"Calculate the radius of toggles."
	ry := self morphHeight // 2.
	rx := ry.

	"Draw the background."

	statusColor := self value ifTrue: [Color green] ifFalse: [Color lightGray].

	aCanvas ellipseCenter: rx at ry  
				radius: rx at ry  
				borderWidth: 1  
				borderColor: statusColor
				fillColor: statusColor.

	aCanvas ellipseCenter:  ((self morphExtent x - rx)@ry)
			radius: rx at ry  
			borderWidth: 1
			borderColor: statusColor
			fillColor: statusColor.

	aCanvas fillRectangle: ((rx at 0) corner: ((self morphExtent x - rx)@self morphExtent y)) color: statusColor.

	"Draw either the On or Off toggle." 

	self value ifFalse: [
			aCanvas ellipseCenter: rx at ry  
				radius: ((rx at ry) - 2)  
				borderWidth: 0  
				borderColor: color
				fillColor: color]
		ifTrue: [
			aCanvas ellipseCenter:  ((self morphExtent x - rx)@ry)
				radius: ((rx at ry) - 2)  
				borderWidth: 0
				borderColor: color
				fillColor: color] ! !

!PreferenceToggleButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:45:06'!
handlesMouseDown: aMouseButtonEvent
	"Do I want to receive mouseDown events (mouseDown:, mouseMove:, mouseUp:)?"
	^true! !

!PreferenceToggleButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:45:06'!
morphExtent

	^ extent ifNil: [extent := self defaultExtent]! !

!PreferenceToggleButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:45:06'!
morphExtent: aPoint

	"The extent of this widget is set once when initializing it. Then it does not change anymore."
	"We need to ignore further calls from LayoutMorphs so that extent doesn't change."
	extent ifNil: [super morphExtent: aPoint]! !

!PreferenceToggleButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:45:06'!
morphLocalBounds

	^`0 at 0` extent: self morphExtent.! !

!PreferenceToggleButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:45:06'!
mouseButton1Down: aMouseButtonEvent localPosition: localEventPosition

	isPressed _ true.
	self redrawNeeded.
	(actWhen == #buttonDown or: [ actWhen == #buttonStillDown ])
		ifTrue: [
			self performAction ]
		ifFalse: [
			"Don't make multi-click slower if we act on button down, just do multiple actions"
			aMouseButtonEvent hand
				waitForClicksOrDragOrSimulatedMouseButton2: self
				event: aMouseButtonEvent
				clkSel: nil
				clkNHalf: nil
				dblClkSel: #doubleClick:localPosition:
				dblClkNHalfSel: nil
				tripleClkSel: nil ]! !

!PreferenceToggleButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:45:06'!
performAction
	"Inform the model that this button has been pressed. "

	actionSelector ifNotNil: [
		actionSelector isBlock ifTrue: [actionSelector value]
		ifFalse: [	model perform: actionSelector ]]
	! !

!PreferenceToggleButtonMorph methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:45:06'!
value

	^ model perform: getStateSelector ! !

!PreferenceToggleButtonMorph class methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:46:47'!
example1

	|s|

	s := Switch newOff.

	(PreferenceToggleButtonMorph on: s)
		getStateSelector: #isOn;
		actionSelector: #switch;
		morphExtent: 30 at 16;
		openInWorld

	! !

!PreferenceToggleButtonMorph class methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 21:22:20'!
example2

	|s|

	s := Switch newOff.

	(PreferenceToggleButtonMorph on: s)
		getStateSelector: #isOn;
		actionSelector: #switch;
		openInWorld

	! !

!PreferenceToggleButtonMorph class methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:45:06'!
model: aModel

	^ self new 
		model: aModel;
		yourself! !

!PreferenceToggleButtonMorph class methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:45:06'!
model: anObject stateGetter: getStateSel action: actionSel

	^ self new
		model: anObject;
		getStateSelector: getStateSel;
		actionSelector: actionSel;
		yourself! !

!PreferenceToggleButtonMorph class methodsFor: 'as yet unclassified' stamp: 'MM 6/14/2023 20:45:06'!
on: aModel

	^ self new 
		model: aModel;
		yourself! !

!Switch methodsFor: '*PreferenceBrowser' stamp: 'MM 7/22/2016 15:54'!
value
	^ on! !

!Switch methodsFor: '*PreferenceBrowser' stamp: 'MM 7/22/2016 15:54'!
value: value
	value ifTrue: [self turnOn] ifFalse: [self turnOff]
	! !

!PreferenceSet class methodsFor: '*PreferenceBrowser' stamp: 'MM 6/14/2023 16:58:57'!
openPreferencesInspector
	PreferenceBrowser open! !
PreferenceBrowser initialize!