[Cuis-dev] Preference behavior and Parameters

Wed May 4 13:31:16 PDT 2022

Hi,

This is the third iteration of the class PreferencesNG.

Most of the preferences/parameters found in Preferences/Preferences are 
implemented. There are a few exceptions like the "file list" operation, 
some behaviors could be implemented in the FileList.

Regarding metrics: Preferences/Preference are 180 methods, 942 lines of 
code; PreferencesNG 42 methods, 402 lines of code.

Hilaire

-- 
GNU Dr. Geo
http://drgeo.eu
http://blog.drgeo.eu
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.cuis.st/mailman/archives/cuis-dev/attachments/20220504/3c24e0e6/attachment.htm>
-------------- next part --------------
'From Cuis 6.0 [latest update: #5113] on 4 May 2022 at 8:32:24 pm'!
!classDefinition: #PreferenceNG category: #'System-Support'!
Object subclass: #PreferenceNG
	instanceVariableNames: 'name description category value type'
	classVariableNames: 'ThePreferences'
	poolDictionaries: ''
	category: 'System-Support'!
!PreferenceNG commentStamp: 'hlsf 4/30/2022 12:47:46' prior: 0!
My instance is a Preference whose value is of a given class (type), or follow the description of the type instance

- name, category: symbol
- description: string
- type: a class (Boolean, String, Color, BlockClosure, etc.) or an instance (collection, intervale, etc.)
- value: an object whose class match type or the instance description of the type

Modus Operendi
- To create a Preference, invoke the instance creation class method (Preference name:description:category:type:value:). The new preference is automatically remembered. If a preference with same name already exist, its instance is returned.
- To access, invoke as dictionary (Preference at: #biggerCursors), a short cut exist (Preference biggerCursors)!

!PreferenceNG methodsFor: 'printing' stamp: 'hlsf 4/30/2022 14:42:44'!
printOn: aStream
	aStream nextPutAll: self class name ;
		nextPutAll: ' (';
		nextPutAll: name capitalized ;
		nextPutAll: ' = ';
		nextPutAll: type printString;
		nextPutAll: '::';
		nextPutAll: value printString;
		nextPut: $)! !

!PreferenceNG methodsFor: 'initialization' stamp: 'hlsf 5/3/2022 20:42:49'!
name: nameSymbol description: aString category: categorySymbol type: aType value: aValue
	name _ nameSymbol.
	description _ aString.
	category _ categorySymbol.
	type _ aType ifNotNil: [aType] ifNil: [ aValue class].
	value _ 	aValue! !

!PreferenceNG methodsFor: 'accessing' stamp: 'hlsf 4/30/2022 14:25:45'!
category
	^ category ! !

!PreferenceNG methodsFor: 'accessing' stamp: 'hlsf 5/2/2022 22:19:11'!
category: aSymbol
	aSymbol isNil ifFalse: [category _ aSymbol ]! !

!PreferenceNG methodsFor: 'accessing' stamp: 'hlsf 4/30/2022 14:25:57'!
description
	^ description! !

!PreferenceNG methodsFor: 'accessing' stamp: 'hlsf 5/2/2022 22:18:30'!
description: aString
	aString isEmptyOrNil ifFalse: [description _ aString ]! !

!PreferenceNG methodsFor: 'accessing' stamp: 'hlsf 4/30/2022 14:26:02'!
name
	^ name! !

!PreferenceNG methodsFor: 'accessing' stamp: 'hlsf 5/3/2022 21:16:04'!
value
" If my type is closure without argument, return my value "
	^ (type == BlockClosure and: [value argumentCount = 0])
		ifTrue: [value value]
		ifFalse: [value]
	! !

!PreferenceNG methodsFor: 'accessing' stamp: 'hlsf 5/3/2022 20:54:17'!
value: aValue	
	type class class == Metaclass "type is a Class"
		ifTrue: [
			(aValue isKindOf: type) ifFalse: [self error: aValue printString, ' is not a ', type printString].
			value _ aValue .				
			]
		ifFalse: [ "Should be handled somehow by the preference editor "
			value _ aValue].
	self triggerEvent: #preferenceChanged with: self! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

!classDefinition: 'PreferenceNG class' category: #'System-Support'!
PreferenceNG class
	instanceVariableNames: ''!

!PreferenceNG class methodsFor: 'accessing' stamp: 'hlsf 4/30/2022 21:11:22'!
all
	^ ThePreferences 
	! !

!PreferenceNG class methodsFor: 'accessing' stamp: 'hlsf 4/30/2022 22:21:36'!
at: symbolName
	^ (self instanceAt: symbolName) value! !

!PreferenceNG class methodsFor: 'accessing' stamp: 'hlsf 5/3/2022 20:47:15'!
at: symbolName put: aValue
	| myPref |
	myPref _ self instanceAt: symbolName. 
	myPref value: aValue! !

!PreferenceNG class methodsFor: 'accessing' stamp: 'hlsf 4/30/2022 14:28:57'!
categories
	| categories |
	categories _ Set new.
	ThePreferences values do: [:aPreference | categories add: aPreference category].
	^ categories sorted! !

!PreferenceNG class methodsFor: 'accessing' stamp: 'hlsf 4/30/2022 22:19:26'!
instanceAt: symbolName
	^ ThePreferences at: symbolName ifAbsent: [self error: 'Unknown preference ', symbolName ]! !

!PreferenceNG class methodsFor: 'accessing' stamp: 'hlsf 4/30/2022 14:29:56'!
select: aCategory
" I select the preferences of the given category "
	^ ThePreferences values select: [:aPreference | aPreference category == aCategory ]! !

!PreferenceNG class methodsFor: 'instance creation' stamp: 'hlsf 5/3/2022 19:16:59'!
name: nameSymbol category: categorySymbol value: aValue
	self name: nameSymbol description: nil category: categorySymbol type: nil value: aValue 
! !

!PreferenceNG class methodsFor: 'instance creation' stamp: 'hlsf 5/3/2022 19:59:49'!
name: nameSymbol description: aString category: categorySymbol type: aType value: aValue
"If I exist, I am updated with the newer sent data "
	(nameSymbol isSymbol or: [categorySymbol isSymbol]) ifFalse: 
		[self error: 'Preference Name & Category are not valid symbol.'].
	^ ThePreferences 
		at: nameSymbol
		ifPresent: [:thePref |
			thePref 
				description: aString;
				category: categorySymbol;
				value: aValue;
				yourself]
		ifAbsent: [ | newPref |
			newPref _ self new ::
				name: nameSymbol 
				description: aString 
				category: categorySymbol 
				type: aType 
				value: aValue.
			ThePreferences at: nameSymbol put: newPref ].
	! !

!PreferenceNG class methodsFor: 'error handling' stamp: 'hlsf 4/30/2022 22:20:35'!
doesNotUnderstand: aMessage
	aMessage hasArguments ifTrue: [^ super doesNotUnderstand: aMessage].
	^ self at: aMessage selector! !

!PreferenceNG class methodsFor: 'class initialization' stamp: 'hlsf 4/30/2022 21:07:47'!
initialize
	self reset! !

!PreferenceNG class methodsFor: 'fileIn/Out' stamp: 'hlsf 4/30/2022 22:10:43'!
loadFrom: aFileEntry
" Load all preferences from file, it replaces entirely the existing preferences "
	ThePreferences _ SmartRefStream restoreFromFile: aFileEntry! !

!PreferenceNG class methodsFor: 'fileIn/Out' stamp: 'hlsf 4/30/2022 22:10:56'!
mergeWith: aFileEntry
" Load the preferences from file and merge with the existing preferences. 
Duplicates from file replace the ones in system "
	| newPrefs |
	newPrefs _ 	SmartRefStream restoreFromFile: aFileEntry.
	newPrefs associationsDo: [:assoc | 		ThePreferences at: assoc key put: assoc value]! !

!PreferenceNG class methodsFor: 'fileIn/Out' stamp: 'hlsf 4/30/2022 22:20:56'!
save: nameSymbol to: aFileEntry
" Save one preference to a file, even for a sole preference we save in a Dictionary"
	| myPref |
	myPref _ self instanceAt: nameSymbol.
	SmartRefStream 
		dumpOnFile: aFileEntry 
		object: {myPref name -> myPref} asDictionary! !

!PreferenceNG class methodsFor: 'fileIn/Out' stamp: 'hlsf 4/30/2022 21:58:19'!
saveAllTo: aFileEntry
" Save all the preferences to a file "
	SmartRefStream dumpOnFile: aFileEntry object: ThePreferences! !

!PreferenceNG class methodsFor: 'fileIn/Out' stamp: 'hlsf 4/30/2022 21:57:59'!
saveCategory: categorySymbol to: aFileEntry
	| myPref |
	myPref _ self select: categorySymbol.
	SmartRefStream 
		dumpOnFile: aFileEntry 
		object: 	(myPref collect: [:aPref | aPref name -> aPref ]) asDictionary! !

!PreferenceNG class methodsFor: 'helpers' stamp: 'hlsf 5/1/2022 18:34:41'!
detectType: anObject
	^ anObject class 
		caseOf: {
			[True] -> [Boolean].
			[False] -> [Boolean].
		}
		otherwise: [anObject class]
! !

!PreferenceNG class methodsFor: 'event handlers' stamp: 'hlsf 5/4/2022 16:12:03'!
assignmentGlyph: assignmentPref
	AbstractFont withAllSubclassesDo: [ :fontClass | fontClass assignmentGlyphSelectorPreferenceChanged ]! !

!PreferenceNG class methodsFor: 'event handlers' stamp: 'hlsf 5/3/2022 20:54:30'!
defaultFontSize: guiElementSizePref
	| font titleFont pointSize |
	pointSize _ self fontSizes at: guiElementSizePref value.
	font _ FontFamily familyName: FontFamily defaultFamilyName pointSize: pointSize.
	PreferenceNG name: #standardListFont category: #font value: font.
	PreferenceNG name: #standardMenuFont category: #font value: font.
	PreferenceNG name: #standardCodeFont category: #font value: font.
	PreferenceNG name: #standardButtonFont category: #font value: font.
	FontFamily defaultFamilyName: font familyName defaultPointSize: pointSize.	
	titleFont _ FontFamily familyName: FontFamily defaultFamilyName pointSize: pointSize * 12//10.
	PreferenceNG name: #windowTitleFont category: #font value: titleFont.
	MorphicCanvas allSubclassesDo: [ :c| c guiSizePreferenceChanged ].
	UISupervisor ui ifNotNil: [ :w | w fontPreferenceChanged ].
	PreferenceNG at: #biggerCursors put: (pointSize > 14).
	Cursor defaultCursor activateCursor.
	^font! !

!PreferenceNG class methodsFor: 'fonts' stamp: 'hlsf 5/3/2022 18:58:38'!
fontSizes
	^ `{
		#tinyFonts -> 7 .
		#verySmallFonts -> 9 .
		#smallFonts ->11 .
		#standardFonts -> 14 .
		#largeFonts -> 18 .
		#veryLargeFonts -> 24 .
		#hugeFonts -> 32} asDictionary`
		! !

!PreferenceNG class methodsFor: 'fonts' stamp: 'hlsf 5/3/2022 19:38:13'!
setDefaultFont: aFontName
	"Change the font on the whole system without changing point sizes."
	FontFamily defaultFamilyName: aFontName.
	Preferences
			setDefaultFont: FontFamily defaultFamilyName
			spec: {
				{#standardListFont. (PreferenceNG at: #standardListFont) pointSize.}.
				{#standardMenuFont. (PreferenceNG at: #standardMenuFont) pointSize.}.
				{#windowTitleFont. (PreferenceNG at: #windowTitleFont) pointSize.}.
				{#standardCodeFont. (PreferenceNG at: #standardCodeFont) pointSize.}.
				{#standardButtonFont. (PreferenceNG at: #standardButtonFont) pointSize.}.
			}.
	MorphicCanvas allSubclassesDo: [ :c| c guiSizePreferenceChanged ].
	UISupervisor ui ifNotNil: [ :w | w fontPreferenceChanged ].! !

!PreferenceNG class methodsFor: 'fonts' stamp: 'hlsf 5/3/2022 19:39:30'!
setDefaultFont: fontFamilyName spec: defaultFontsSpec
	| font |
	defaultFontsSpec do: [ :triplet |
		font _ FontFamily familyName: fontFamilyName pointSize: triplet second.
		font ifNil: [ font _ FontFamily defaultFamilyAndPointSize ]. 
		triplet size > 2 ifTrue: [			font _ font emphasized: triplet third ].
		PreferenceNG at: triplet first put: font ].
	MorphicCanvas allSubclassesDo: [ :c| c guiSizePreferenceChanged ].
	UISupervisor ui ifNotNil: [ :w | w fontPreferenceChanged ].! !

!PreferenceNG class methodsFor: 'default preferences' stamp: 'hlsf 5/4/2022 16:13:29'!
cuisDefaultsFont
	^ #( 
		# (aaFontsColormapDepth 4)
		#(cacheTrueTypeGlyphs true )
		#(loadOnlyLatinGlyphData true )
		#(properDisplayAlphaForFonts false )	
		#(subPixelRenderColorFonts true )
	)! !

!PreferenceNG class methodsFor: 'default preferences' stamp: 'hlsf 5/4/2022 20:22:05'!
cuisDefaultsGui
	^ #( 
		#(balloonHelpEnabled true )
		#(biggerCursors false )		
		#(cacheDisplayContentWhenMovingMorphs true )
		#(cheapWindowReframe false )		
		#(clickGrabsMorphs false )	
		#(ctrlArrowsScrollHorizontally false ) 
		#(drawKeyboardFocusIndicator true )
		#(focusFollowsMouse true )
		#(focusIndicatorWidth 1)
		#(fullScreenLeavesDeskMargins true )
		#(haloEnclosesFullBounds true )
		#(halosShowCoordinateSystem true )
		#(menuKeyboardControl true )
		#(optionalButtons true )		
		#(selectiveHalos true )
		#(subPixelRenderFonts true )	
		#(tapAndHoldEmulatesButton2 true )
		#(tileResizerInWindowMenu true )
		#(wantsMenuIcons true )
	)! !

!PreferenceNG class methodsFor: 'default preferences' stamp: 'hlsf 5/4/2022 16:26:09'!
cuisDefaultsProgramming
	^ #(
		#(allowBlockArgumentAssignment false )
		#(alternativeBrowseIt false )
		#(backgroundColorFillsAllBackground true )
		#(browseWithPrettyPrint false )
		#(classAnnotations #(instanceMethodsCount classMethodsCount linesOfCode))
		#(debugHaloHandle true )
		#(debugLogTimestamp true )
		#(debugShowDamage false )
		#(decorateBrowserButtons true )
		#(diffsInChangeList true )
		#(diffsWithPrettyPrint false )
		#(extraDebuggerButtons true )
		#(fullPrintItInWorkspaces false )
		#(highlightBlockNesting true )
		#(italicsInShout true)
		#(leftArrowAssignmentsInGeneratedCode false )
		#(listClassesHierarchically true )
		#(logDebuggerStackToFile false )
		#(methodAnnotations #(timeStamp linesOfCode messageCategory implementorsCount sendersCount  packages changeSets))	
		#(prettyPrintRectangularBlocks false )
		#(shiftClickShowsImplementors false )
		#(shoutInWorkspaces true )
		#(showAnnotations true )
		#(showLinesInHierarchyViews true )
		#(stylingWithEmphasisInWorkspaces false )
		#(systemCategoryAnnotations #(classCount instanceMethodsCount classMethodsCount linesOfCode))
		#(syntaxHighlightingAsYouType true )
		#(syntaxHighlightingAsYouTypeAnsiAssignment false )
		#(syntaxHighlightingAsYouTypeLeftArrowAssignment false )
		#(thoroughSenders true )
	)		
		! !

!PreferenceNG class methodsFor: 'default preferences' stamp: 'hlsf 5/4/2022 20:23:44'!
cuisDefaultsSystem
	^ #( #(allowNonLocalReturnsInExceptionHandlers true )
		#(askConfirmationOnQuit true )
		#(askToInstallComplexPackage true )
		#(automaticPlatformSettings true )
		#(autoNumberUserChanges false )
		#(caseSensitiveFinds false )
		#(changeSetVersionNumbers true )
		#(checkForSlips true )
		#(checkLostChangesOnStartUp false )
		#(cmdDotEnabled true )
		#(cmdDotInterruptTakesStatistics false )
		#(dismissAllOnOptionClose false )
		#(initialFileListDirectories #roots )
		#(selectionsMayShrink true )
		#(serverMode false )
		#(systemWindowEmbedOK false )
		#(transcriptLogVerbose true )
		#(warnAboutNonLocalReturnsInExceptionHandlers false)
		#(warnIfNoChangesFile true )
		#(warnIfNoSourcesFile true )
	)! !

!PreferenceNG class methodsFor: 'default preferences' stamp: 'hlsf 5/1/2022 18:48:26'!
iconicHaloSpecifications
"Answer an array that characterizes the locations, colors, icons, and selectors of the halo handles 
that may be used in the iconic halo scheme"

^ #(	"selector						horiz			vert			color info						icon key"
	(addDismissHandle:						left			top			(red)						haloDismissIcon 						'Remove')
	(addMenuHandle:						leftCenter			top			(blue lighter)						haloMenuIcon 						'Menu')
	(addGrabHandle:						center			top			(black)						haloGrabIcon 						'Pick up')
	(addDragHandle:						rightCenter			top			(brown)						haloDragIcon 						'Move')
	(addDupHandle:						right			top			(green)						haloDuplicateIcon 						'Duplicate')	

	(addExploreHandle:						left			topCenter			(orange)						haloDebugIcon 						'Explore')
	(addDebugHandle:						right			topCenter			(orange)						haloDebugIcon 						'Debug')
	(addCollapseHandle:						left			center			(tan)						haloCollapseIcon 						'Collapse')
	(addScaleHandle:						right			center			(blue)						haloScaleIcon 						'Change scale')

	(addRotateHandle:						left			bottom			(blue)						haloRotateIcon 						'Rotate')
	(addHelpHandle:						center			bottom			(lightBlue)						haloHelpIcon 						'Help')
	(addResizeHandle:						right			bottom			(yellow)						haloResizeIcon 						'Change size')

	"FIXME - Currently non-functional...
	(addRecolorHandle:						right			bottomCenter			(magenta darker)						haloColorIcon 						'Change color')
	"
)! !

!PreferenceNG class methodsFor: 'default preferences' stamp: 'hlsf 5/4/2022 20:26:20'!
installDefault: category
	(self perform: (#cuisDefaults, category capitalized) asSymbol) do: [:anArray |
		self 
			name: anArray first 				description: '' category: category 
			type: (self detectType: anArray second)			value: anArray second]
		! !

!PreferenceNG class methodsFor: 'default preferences' stamp: 'hlsf 5/4/2022 16:10:30'!
installFontPreferences
	| myPref |
	myPref _ PreferenceNG 
		name: #guiElementsSize 
		description: 'Size of the graphic intereface element' 
		category: #gui 
		type: #(tinyFonts verySmallFonts smallFonts standardFonts largeFonts veryLargeFonts hugeFonts)
		value: #standardFonts.
	myPref when: #preferenceChanged send: #defaultFontSize: to: PreferenceNG.
	"Trigger manually, the preference was instantiated with value, so no setter message sent"
	myPref triggerEvent: #preferenceChanged with: myPref. ! !

!PreferenceNG class methodsFor: 'default preferences' stamp: 'hlsf 5/4/2022 16:10:52'!
installHaloPreferencesWith: anArray
	| aColor |
	^ PreferenceNG 
		name: #haloSpecifications 
		description: 'Halo specifications describing which halos are to be used, what they should look like, and where they should be situated'
		category: #gui
		type: Array
		value: (anArray collect: [ :each |
			aColor _ Color.
			each fourth do: [ :sel | aColor _ aColor perform: sel].
			HaloSpec new 
				horizontalPlacement: each second
				verticalPlacement: each third 
				color: aColor
				iconSymbol: each fifth
				addHandleSelector: each first
				hoverHelp: each sixth])! !

!PreferenceNG class methodsFor: 'default preferences' stamp: 'hlsf 5/4/2022 16:11:03'!
installMiscPreferences
"Preference balue defined with closure. We could insert in a dynamic array..."
	| myPref |
	PreferenceNG 
		name: #haloHandleSize category: #gui 
		value: [(PreferenceNG at: #standardListFont) pointSize * 5 // 3 max: 16].
	PreferenceNG
		name: #roundedButtonsRadius 	category: #gui 
		value: [(PreferenceNG at: #standardListFont) pointSize * 8 // 14].
	PreferenceNG
		name: #roundedWindowRadius 	category: #gui value: [(PreferenceNG at: #standardListFont) pointSize].
	PreferenceNG
		name: #scrollbarThickness category: #gui 		value: [(PreferenceNG at: #windowTitleFont) pointSize + 2].
	PreferenceNG name: #classFinder category: #programming value: [ BrowserWindow findClass ].
	PreferenceNG name: #defaultAuthorName category: #programming value: [Utilities authorName].
	PreferenceNG name: #userChangeFileNameExtension category: #system value: '.user.changes'.
	" Shout assignment character "
	myPref _ PreferenceNG name: #assignmentGlyphSelector description: 'How should look like the assignment character?' category: #programming  type: #(useLeftArrow useAlwaysLeftArrow) value: #useLeftArrow.
	myPref when: #preferenceChanged send: #assignmentGlyph: to: PreferenceNG.! !

!PreferenceNG class methodsFor: 'default preferences' stamp: 'hlsf 5/4/2022 20:26:43'!
reset
	ThePreferences _ Dictionary new.
	#(font gui programming system) do: [: category | self installDefault: category].
	self installHaloPreferencesWith: self iconicHaloSpecifications.
	self installFontPreferences.
	self installMiscPreferences 
		! !

!PreferenceNG class methodsFor: 'obsolete' stamp: 'hlsf 5/4/2022 14:56:05'!
desktopMenuTitle
"I have project to get rid of this one"
	^ 'World'   ! !

!PreferenceNG class methodsFor: 'obsolete' stamp: 'hlsf 4/30/2022 14:39:32'!
import
"Import the preferences from the old system"
	Preferences preferencesDictionary valuesDo: [:oldPref |
		PreferenceNG 
			name: oldPref name 
			description: (oldPref instVarNamed: #helpString)
			category: (oldPref instVarNamed: #categoryList) first
			type: Object
			value: oldPref preferenceValue 
		]! !

PreferenceNG initialize!