[Cuis-dev] [IMPROV] Preferences Menu With Better Feedback

Gerald Klix cuis.01 at klix.ch
Sat Sep 4 08:55:24 PDT 2021


On 9/1/21 1:55 PM, Hernan Wilkinson wrote:
> a little bit late, but it looks very nice!
Your are welcome! And you aren't late:

I now have a final version ready,
that properly -- according to Gerald :} --categorizes
all boolean preferences and has a submenu for each of these
categories. I also added some stuff that Ken missed
directly to the preference menu.

If you all agree with the current design,
I will convert it to change-set and submit it
for integration.


Have fun,

Gerald



> 
> On Tue, Aug 31, 2021 at 5:03 PM Gerald Klix via Cuis-dev <
> cuis-dev at lists.cuis.st> wrote:
> 
>> On 8/31/21 6:03 PM, Juan Vuletich wrote:
>>> On 8/30/2021 9:54 AM, Gerald Klix via Cuis-dev wrote:
>>>> Hi all, Hi Juan,
>>>>
>>>> Please find attached a (rather big) package that reworks
>>>> the preferences menu. My main objective was to provide
>>>> better user feedback by showing the currently
>>>> active setting where feasible.
>>>>
>>>> I am looking forward toyour feedback.
>>>> If the changes are acceptable,
>>>> I will convert the package to change-set
>>>> and resubmit it.
>>>>
>>>>
>>>> HTH and Best Regards,
>>>>
>>>> Gerald
>>>
>>> Hi Gerald,
>>>
>>> Thanks! I really like it.
>> You are welcome.
>>
>> Tomorrow, while building the VMs, I will clean up the code a bit,
>> change the font/ui sizes and font selection menus,
>> and add an extended preferences menu for
>> code preferences and the like.
>>
>>
>> Best Regards,
>>
>> Gerald
>> --
>> Cuis-dev mailing list
>> Cuis-dev at lists.cuis.st
>> https://lists.cuis.st/mailman/listinfo/cuis-dev
>>
> 
> 

-------------- next part --------------
'From Haver 5.0 [latest update: #4832] on 4 September 2021 at 5:34:52 pm'!
'Description '!
!provides: 'PreferencesMenu' 1 18!
SystemOrganization addCategory: 'PreferencesMenu'!






!Boolean methodsFor: '*PreferencesMenu-user interface support' stamp: 'KLG 9/1/2021 17:33:22'!
asMenuItemTextPrefix
	"Answer '<Yes>' or  '<No>' to prefix a menu item text with a check box. "

	^ self subclassResponsibility! !

!False methodsFor: '*PreferencesMenu-user interface support' stamp: 'KLG 9/1/2021 17:33:51'!
asMenuItemTextPrefix
	"Answer '<Yes>' or  '<No>' to prefix a menu item text with a check box. "

	^ '<No>'! !

!True methodsFor: '*PreferencesMenu-user interface support' stamp: 'KLG 9/1/2021 17:34:02'!
asMenuItemTextPrefix
	"Answer '<Yes>' or  '<No>' to prefix a menu item text with a check box. "

	^ '<Yes>'! !

!String methodsFor: '*PreferencesMenu-converting' stamp: 'KLG 9/4/2021 00:04:26'!
displayStringFromUnarySelector
	"Answer a display string from a selector."

	^ self displayStringFromUnarySelector: true! !

!String methodsFor: '*PreferencesMenu-converting' stamp: 'KLG 9/4/2021 16:38:41'!
displayStringFromUnarySelector: aUppercaseFlag
	"Answer a display string from a selector."

	| wasUpperCase |
	^ String streamContents: [ :stream |
		stream nextPut: (
			aUppercaseFlag
				ifTrue: [ self first asUppercase ]
				ifFalse: [ self first asLowercase ]).
		wasUpperCase _ true.
		self from: 2 to: self size do: [ :character | | isUpperCase |
			(isUpperCase _ character isUppercase)
				ifFalse: [ stream nextPut: character ]
				ifTrue: [
					"Don't separate adajcent upper case letters with spaces, like <isXyzOK>:"
					wasUpperCase ifFalse: [ stream nextPut: `Character space` ].
					stream nextPut:
						(aUppercaseFlag
							ifTrue: [ character asUppercase ]
							ifFalse: [ character asLowercase ]) ].
				wasUpperCase _ isUpperCase ] ]! !

!Preferences class methodsFor: '*PreferencesMenu-user interface support' stamp: 'KLG 9/4/2021 17:21:59'!
addBooleanItemsForCategory: aCategory toMenu: aMenu
	"Add the items for aCategory to aMenu."

	self booleanPreferencesByCategory at: aCategory :: sorted:
		[ :itemDescription1 :itemDescription2 | itemDescription1 second < itemDescription2 second ] ::
			do: [ :itemDescription | | itemText selector |
				selector _ itemDescription first.
				itemText _ itemDescription second.
				aMenu 
					addUpdating: itemText
					target: self 
					action:  #togglePreference:
					argumentList: {selector} ::
						checkedBlock: [ self perform: selector ] ]! !

!Preferences class methodsFor: '*PreferencesMenu-add preferences' stamp: 'KLG 9/4/2021 13:08:23'!
addPreference: prefSymbol categories: categoryList default: aValue balloonHelp: helpString changeInformee: informeeSymbol  changeSelector: aChangeSelector
	"Add or replace a preference as indicated.  Reuses the preexisting Preference object for this symbol, if there is one, so that UI artifacts that interact with it will remain valid."

	| aPreference |
	aPreference _ self preferencesDictionary at: prefSymbol ifAbsent: [Preference new].
	aPreference name: prefSymbol defaultValue: aValue helpString: helpString categoryList: categoryList changeInformee: informeeSymbol changeSelector: aChangeSelector.
	self preferencesDictionary at: prefSymbol put: aPreference.
	self compileAccessMethodForPreference: aPreference.
	BooleanPreferencesByCategory _ nil! !

!Preferences class methodsFor: '*PreferencesMenu-user interface support' stamp: 'KLG 9/4/2021 16:41:38'!
booleanPreferenceCategories
	"Answer all boolean preference categories."

	^ self booleanPreferencesByCategory keys sorted! !

!Preferences class methodsFor: '*PreferencesMenu-user interface support' stamp: 'KLG 9/4/2021 17:32:49'!
booleanPreferencesByCategory
	"Answer a dictionary that maps preference categories to boolean perfernces.
	
	We use a hard coded dictionary here, becuase the single prferences may not
	all be present and the all have the same category array `#(misc)`."

	self flag: #KLG. "Implement item texts:"
	BooleanPreferencesByCategory ifNil: [
		BooleanPreferencesByCategory _ Dictionary new.
		self preferenceDescriptions  do: [ :preferenceDescription | | selector value |
			self assert: (preferenceDescription size between: 2 and: 4).
			selector _ preferenceDescription first.
			(value _ self perform: selector) isKindOf: Boolean :: ifTrue: [ | categories ballonHelp preference itemText |
				preferenceDescription size > 2
					ifTrue: [ itemText _ preferenceDescription third ]
					ifFalse: [ itemText _ selector displayStringFromUnarySelector ].
				preferenceDescription size > 3 ifTrue: [ ballonHelp _ preferenceDescription fourth ].
				(categories _ preferenceDescription second) isString
					ifTrue: [ categories _ {categories} ].
				preference _ self preferenceAt: selector ifAbsent: [
					DictionaryOfPreferences at: selector put: Preference new ].
				preference 
					name: selector 
					defaultValue: value 
					helpString: ballonHelp 
					categoryList: categories
					changeInformee: nil
					changeSelector: nil.
				categories do: [ :category |
					BooleanPreferencesByCategory
						at: category
						ifAbsentPut: [ IdentitySet new ] ::
							add: {selector. itemText} ] ] ] ].
	^ BooleanPreferencesByCategory! !

!Preferences class methodsFor: '*PreferencesMenu-cached state access' stamp: 'KLG 8/23/2021 21:33:24'!
initClassCachedState
	"Check the initial file list directories for existence."
	
	| initialDirectories |
	(initialDirectories _ self initialFileListDirectories) isSymbol ifTrue: [ ^ self ].
	initialDirectories copy do: [ :directoryEntry |
		directoryEntry exists ifFalse:
			[ self removeInitialFileListDirectory: directoryEntry ] ]! !

!Preferences class methodsFor: '*PreferencesMenu-menu subtitles' stamp: 'KLG 8/28/2021 00:13:33'!
menusShowSubSectionTitles: aFlag
	"Answer true if menus should show sub section titles."

	^ self setPreference: #menusShowSubSectionTitles toValue: aFlag! !

!Preferences class methodsFor: '*PreferencesMenu-preferences panel' stamp: 'KLG 9/4/2021 13:27:26'!
openPreferencesExplorer
	"Open a window on the current set of preferences choices, allowing the user to view and change their settings
	
	We just an explorer."
	
	self preferencesDictionary explore! !

!Preferences class methodsFor: '*PreferencesMenu-user interface support' stamp: 'KLG 9/4/2021 17:30:05'!
preferenceDescriptions
	"Answer the preference descriptions for the mens.
	
	1st) selector
	2nd) Category or an array of them
	3rd) Optional menu item text, if omitted, the selector is used
	4th) Balloon help text, if ommitted, well ..."

	^ #(
		(#allowBlockArgumentAssignment 'Programming')
	 	(#alternativeBrowseIt 'Browsing')
		(#autoNumberUserChanges 'Programming') 
		(#automaticPlatformSettings 'Meta')
		(#balloonHelpEnabled 'UI')
		(#biggerCursors 'UI')
		(#browseWithPrettyPrint ('Browsing' 'Programming'))
		(#canRecordWhilePlaying 'Sound')
		(#caseSensitiveFinds ('Browsing' 'Programming')) 
		(#changeSetVersionNumbers 'Programming') 
		(#cheapWindowReframe ('UI' 'Events')) 
		(#checkForSlips 'Programming')
		(#clickGrabsMorphs 'Events')
		(#cmdDotEnabled 'Debugging')
		(#ctrlArrowsScrollHorizontally 'Events')
		(#debugHaloHandle ('UI' 'Debugging'))
		(#debugLogTimestamp 'Debugging')
		(#debugShowDamage 'Debugging')
		(#debugShowDamage2 'Debugging')
		(#decorateBrowserButtons 'Browsing')
		(#diffsInChangeList 'Browsing')
		(#diffsWithPrettyPrint 'Browsing')
		(#dismissAllOnOptionClose ('UI' 'Events'))
		(#drawKeyboardFocusIndicator ('UI' 'Events'))
		(#extraDebuggerButtons 'Debugging')
		(#focusFollowsMouse 'Events')
		(#fullScreenLeavesDeskMargins 'UI')
		(#haloEnclosesFullBounds 'UI')
		(#halosShowCoordinateSystem 'UI')
		(#leftArrowAssignmentsInGeneratedCode 'Programming')
		(#listClassesHierarchically 'Browsing')
		(#logDebuggerStackToFile 'Debugging')
		(#menuKeyboardControl ('Menus' 'Events'))
		(#menusShowSubSectionTitles ('Menus' 'UI') 'Menus Show Section Titles')
		(#optionalButtons 'Browsing')
		(#prettyPrintRectangularBlocks 'Programming')
		(#selectionsMayShrink 'UI')
		(#selectiveHalos 'UI')
		(#serverMode ('Meta' 'Events'))
		(#showAnnotations 'Browsing')
		(#showLinesInHierarchyViews 'UI') 
		(#soundQuickStart 'Sound')
		(#soundStopWhenDone 'Sound')
		(#soundsEnabled 'Sound')
		(#subPixelRenderFonts  'UI')
		(#syntaxHighlightingAsYouType 'Programming')
		(#syntaxHighlightingAsYouTypeAnsiAssignment 'Programming')
		(#syntaxHighlightingAsYouTypeLeftArrowAssignment 'Programming')
		(#systemWindowEmbedOK ('UI' 'Events'))
		(#tapAndHoldEmulatesButton2 'Events')
		(#thoroughSenders 'Browsing')
		(#tileResizerInWindowMenu ('UI' 'Menus')) 
		(#transcriptLogVerbose  'Programming')
		(#wantsMenuIcons ('UI' 'Menus') 'Menus Show Icons')
		(#warnIfNoChangesFile ('Programming' 'Meta'))
		(#warnIfNoSourcesFile ('Programming' 'Meta'))
		(leftArrowAssignmentsInGeneratedCodeWithComputedDefault 'Programming')
		(allowNonLocalReturnsInExceptionHandlers 'Programming')
		(warnAboutNonLocalReturnsInExceptionHandlers 'Programming')
		(loadOnlyLatinGlyphData 'UI')
		(properDisplayAlphaForFonts 'UI')
		(subPixelRenderColorFonts 'UI')
		(askConfirmationOnQuit ('Events' 'Meta'))
		(askToInstallComplexPackage ('Programming' 'Meta'))
		(fullPrintItInWorkspaces 'Programming')
		(stylingWithEmphasisInWorkspaces ('UI' 'Shout'))
		(usePreDebugWindow ('Debugging' 'Meta'))
		(backgroundColorFillsAllBackground 'Shout')
		(highlightBlockNesting 'Shout')
		(italicsInShout 'Shout')
		(shoutInWorkspaces ('UI' 'Shout' 'Programming'))
		(checkLostChangesOnStartUp ('Programming' 'Meta'))
	)! !

!Preferences class methodsFor: '*PreferencesMenu-cached state access' stamp: 'KLG 9/4/2021 13:48:45'!
releaseClassCachedState
	"Remove our categories cache."
	
	BooleanPreferencesByCategory _ nil! !

!Preferences class methodsFor: '*PreferencesMenu-get/set' stamp: 'KLG 9/4/2021 00:31:22'!
togglePreference: prefSymbol
	"Toggle the given preference"

	self 
		preferenceAt: prefSymbol 
		ifAbsent: [
			self respondsTo: prefSymbol ::
				ifTrue: [ | oldValue |
					(oldValue _ self perform: prefSymbol) respondsTo: #not :: 
						ifTrue: [
							^ self
								setPreference: prefSymbol
								toValue: oldValue not]
						ifFalse: [ 
							self error: 'Can''t toggle non-boolean preference' ] ].
				self error: 'unknown preference: ', prefSymbol ] ::
		togglePreferenceValue! !

!TaskbarMorph methodsFor: '*PreferencesMenu-menus' stamp: 'KLG 8/30/2021 11:56:16'!
addConfigurationOptionsToMenu: aMenu
	"Add my configuration options to a aMenu."

	^self class addConfigurationOptionsToMenu: aMenu! !

!TaskbarMorph methodsFor: '*PreferencesMenu-menus' stamp: 'KLG 8/30/2021 11:49:24'!
mouseButton2Activity

	| menu |
	menu _ MenuMorph new defaultTarget: self.
	self addConfigurationOptionsToMenu: menu.
	menu popUpInWorld! !

!TaskbarMorph class methodsFor: '*PreferencesMenu-menus' stamp: 'KLG 8/30/2021 14:10:55'!
addConfigurationOptionsToMenu: aMenu
	"Add my configuration options to a aMenu."

	| enableTaskbarItems taskbarTarget checkBlockGenerator |
	enableTaskbarItems _ [ self runningWorld taskbar notNil ].
	taskbarTarget _ [ self runningWorld taskbar ].
	checkBlockGenerator _ [ :scaleToCheck |
		[ self runningWorld taskbar ifNotNil: [ :tb | tb scale = scaleToCheck ] ] ].
	aMenu
		add: 'Show taskbar' target: self runningWorld action: #showTaskbar  icon: #expandIcon ::
			setBalloonText: 'Show the taskbar'.
	aMenu
		add: 'Hide taskbar' target: self runningWorld action: #hideTaskbar  icon: #collapseIcon ::
			setBalloonText: 'Hide the taskbar'.
	aMenu
	        addSubSectionLine;
		addUpdating: 'Small Height' target: taskbarTarget action: #scaleSmall ::
			isEnabled: enableTaskbarItems;
			checkedBlock: (checkBlockGenerator value: 0.5).
	aMenu
		addUpdating: 'Normal Height' target: taskbarTarget action: #scaleNormal :: 
			isEnabled: enableTaskbarItems ::
			checkedBlock: (checkBlockGenerator value: 1).
	aMenu 
		addUpdating: 'Scale x 2' target: taskbarTarget action: #scaleX2 ::
			isEnabled: enableTaskbarItems ::
			checkedBlock: (checkBlockGenerator value: 2).
	aMenu 
		addUpdating: 'Scale x 4' target: taskbarTarget action: #scaleX4  ::
			isEnabled: enableTaskbarItems ::
			checkedBlock:  (checkBlockGenerator value: 4)! !

!MenuItemMorph methodsFor: '*PreferencesMenu-drawing' stamp: 'KLG 8/30/2021 13:37:04'!
drawOn: aCanvas 
	| stringColor leftEdge magnifiedIcon |

	stringColor _ color.
	isSelected & self isEnabled
		ifTrue: [
			aCanvas fillRectangle: self morphLocalBounds color: Theme current menuHighlight].
	leftEdge _ 0.

	self hasMarker ifTrue: [
		leftEdge _ leftEdge + submorphs first morphWidth + 8 ].

	icon ifNotNil: [
		magnifiedIcon _ self magnifiedIcon.
		aCanvas image: magnifiedIcon at: leftEdge+1 @ (magnifiedIcon height *1//10).
		leftEdge _ magnifiedIcon width *12//10 + leftEdge].

	aCanvas
		drawString: contents
		at: leftEdge @ 1
		font: self fontToUse
		color: stringColor.
	subMenu ifNotNil: [
		aCanvas
			image: self class subMenuMarker
			at: extent x - 8 @ (extent y - self class subMenuMarker height // 2) ]! !

!MenuItemMorph methodsFor: '*PreferencesMenu-events' stamp: 'KLG 8/30/2021 12:58:41'!
invocationTarget
	"Answer the target for invocations.
	
	Overidden in subclasses, e.g. UpdatingMenuItemMorph."

	^ target! !

!MenuItemMorph methodsFor: '*PreferencesMenu-events' stamp: 'KLG 8/30/2021 12:57:51'!
invokeWithEvent: evt
	"Perform the action associated with the given menu item."

	| selArgCount w |
	self isEnabled ifFalse: [^ self].
	owner ifNotNil: [
		self flag: #workAround. "The tile system invokes menus straightforwardly so the menu might not be in the world."
		(w _ self world) ifNotNil:[
			owner deleteIfPopUp: evt.
			"Repair damage before invoking the action for better feedback"
			w displayWorldSafely]].
	selector ifNil: [ ^self ].
	(selArgCount _ selector numArgs) = 0
		ifTrue: [
			self invocationTarget perform: selector]
		ifFalse: [
			selArgCount = arguments size
				ifTrue: [self invocationTarget perform: selector withArguments: arguments]
				ifFalse: [self invocationTarget perform: selector withArguments: (arguments copyWith: evt)]]! !

!MenuItemMorph methodsFor: '*PreferencesMenu-layout' stamp: 'KLG 8/30/2021 14:01:17'!
magnifiedIcon

	| iconForm w h factor magnifiedExtent magnifiedIcon |
	icon ifNil: [ ^nil ].
	iconForm _ self isEnabled ifTrue: [ icon ] ifFalse: [ icon asGrayScaleAndTransparent ].
	magnifiedIcon _ iconForm.
	w _ iconForm width.
	h _ iconForm height.
	w*h = 0 ifFalse: [
		factor _ extent y * 0.8 / h.
		factor = 1.0 ifFalse: [
			magnifiedExtent _ (iconForm extent * factor) rounded.
			magnifiedIcon _ iconForm magnifyTo: magnifiedExtent ]].
	^magnifiedIcon! !

!UpdatingMenuItemMorph methodsFor: '*PreferencesMenu-accessing' stamp: 'KLG 8/30/2021 13:54:27'!
checkedBlock: aBlock
	"Set a block that adds a check box to the item line."

	self setProperty: #checkedBlock toValue: aBlock! !

!UpdatingMenuItemMorph methodsFor: '*PreferencesMenu-events' stamp: 'KLG 8/30/2021 12:58:51'!
invocationTarget
	"Answer the target for invocations.
	
	Overidden in subclasses, e.g. UpdatingMenuItemMorph."

	^ target value! !

!UpdatingMenuItemMorph methodsFor: '*PreferencesMenu-accessing' stamp: 'KLG 8/30/2021 13:36:48'!
isEnabled

	^ isEnabled value! !

!UpdatingMenuItemMorph methodsFor: '*PreferencesMenu-accessing' stamp: 'KLG 8/30/2021 13:28:37'!
isEnabled: aBooleanProvider
	"Enable me according to aBoolean or aBlock."

	super isEnabled: aBooleanProvider value.
	isEnabled _ aBooleanProvider! !

!UpdatingMenuItemMorph methodsFor: '*PreferencesMenu-world' stamp: 'KLG 8/30/2021 13:55:08'!
updateContents
	"Update the receiver's contents"

	| newString nArgs realWordingProvider |
	"Allow ordinary strings for conveniencer:"
	wordingSelector isSymbol
		ifFalse: [ self updateStringContents ]
		ifTrue: [
			realWordingProvider _ wordingProvider value.
			(realWordingProvider isNil) or: [ wordingSelector isNil ] :: ifFalse: [
				nArgs _ wordingSelector numArgs.
				newString _ nArgs = 0
					ifTrue: [
						realWordingProvider perform: wordingSelector ]
					ifFalse: [
						nArgs = arguments size ifTrue: [
							realWordingProvider perform: wordingSelector withArguments: arguments ] ].
				newString = (contentString ifNil: [ contents ])
					ifFalse: [
						self contents: newString ] ] ].
	isEnabled isBlock ifTrue: [ 
		self color: (isEnabled value ifTrue: [`Color black`] ifFalse: [`Color gray`]) ]! !

!UpdatingMenuItemMorph methodsFor: '*PreferencesMenu-world' stamp: 'KLG 8/30/2021 14:16:32'!
updateStringContents
	"Update the contents when my wording selector is astring."

	^ self contents:  (self valueOfProperty: #checkedBlock ifAbsent: [ ^ self contents: wordingSelector ] ::
		value 
			ifNil: [ wordingSelector ]
			ifNotNil: [ :checked |
				checked
					ifTrue: ['<Yes>' ]
					ifFalse: [ '<No>' ] :: , 
						wordingSelector ])! !

!MenuMorph methodsFor: '*PreferencesMenu-construction' stamp: 'KLG 8/30/2021 12:50:07'!
addItemsFromDictionaries: dataForMenuDicts
	"A menu constructor utility that uses Dictionaries with elements:
		#label - the name that displays in the menu
		#object - the target object. If nil, use defaultTarget. If a Symbol, send it as message to defaultTarget to get real target.
		#selector - the selector called on object when the menu item is selected
		#arguments - optional collection of arguments passed to the selector
		#balloonText - optional 'tool tip' style help text
		#icon-	optional icon selector or Form

	note, nil elements will add a line."
	| item wantsIcons |
	wantsIcons _ Preferences wantsMenuIcons.
	dataForMenuDicts do: [ :itemSpec |
		itemSpec
			ifNil: [ self addSubSectionLine ]
			ifNotNil: [ 
				itemSpec isString
					ifTrue: [ self addSection: itemSpec ]
					ifFalse: [
						| realTarget |
						realTarget _ itemSpec at: #object ifAbsent: [defaultTarget].
						realTarget isSymbol ifTrue: [ realTarget _ defaultTarget perform: realTarget ].
						item _ (itemSpec at: #label) isSymbol
							ifTrue: [
								self
									addUpdating: (itemSpec at: #label)
									target: realTarget
									action: (itemSpec at: #selector)
									argumentList:
										(itemSpec
											at: #arguments
											ifAbsent: [ #() ]) ]
							ifFalse: [
								self
									add: (itemSpec at: #label)
									target: realTarget
									action: (itemSpec at: #selector)
									argumentList:
										(itemSpec
											at: #arguments
											ifAbsent: [ #() ]) ].
						wantsIcons ifTrue: [
							itemSpec
								at: #icon
								ifPresent: [ :symbolOrFormOrNil |
									item setIcon: symbolOrFormOrNil ]].
						itemSpec
							at: #balloonText
							ifPresent: [ :balloonText |
								item setBalloonText: balloonText ] ] ] ]! !

!MenuMorph methodsFor: '*PreferencesMenu-construction' stamp: 'KLG 8/30/2021 12:50:31'!
addSection: aString
	"Either add a section or just a line, depending on preference settings."

	titleMorph ifNil: [ 
		^ self hasSubmorphs
			ifTrue: [ self addLine ]
			ifFalse: [ self ] ].
	^ Preferences menusShowSubSectionTitles
		ifTrue: [ self addTitle: aString ]
		ifFalse: [ submorphs size = 1 ifFalse: [ self addLine ] ]! !

!MenuMorph methodsFor: '*PreferencesMenu-construction' stamp: 'KLG 8/30/2021 12:49:28'!
addSubSectionLine
	"Either add a line,, if we have real sections or do nothing."

	Preferences menusShowSubSectionTitles
		ifTrue: [ self addLine ]! !

!TheWorldMenu methodsFor: '*PreferencesMenu-construction' stamp: 'KLG 9/1/2021 18:06:21'!
autoNumberUserChanges
	"Answer the menu for generating automatic user changes files."
	
	^ Preferences autoNumberUserChanges asMenuItemTextPrefix, 'Numbered user changes files'! !

!TheWorldMenu methodsFor: '*PreferencesMenu-construction' stamp: 'KLG 9/1/2021 18:13:16'!
changeSetVersionNumbers
	"Answer the menu for generating versioned change set files.."
	
	^ Preferences changeSetVersionNumbers asMenuItemTextPrefix, 'Version numbered change set files'! !

!TheWorldMenu methodsFor: '*PreferencesMenu-construction' stamp: 'KLG 9/1/2021 18:32:50'!
clickGrabsMorphs
	"Answer the menu item for click grabs morph"
	
	^ Preferences clickGrabsMorphs asMenuItemTextPrefix, 'Click grabs morph'! !

!TheWorldMenu methodsFor: '*PreferencesMenu-construction' stamp: 'KLG 8/30/2021 10:56:49'!
extensionThemesMenu
	"Budil the extension themes menu."

	| menu |
	menu _ self menu: 'Extension Themes ...'.
	Theme addThemeChangersToMenu: menu  forExtensionThemes: true.
	^ menu
		! !

!TheWorldMenu methodsFor: '*PreferencesMenu-construction' stamp: 'KLG 9/1/2021 17:37:36'!
focusFollowsMouse
	"Answer the label for focus follows mouse.."
	
	^ Preferences focusFollowsMouse asMenuItemTextPrefix, 'Focus follows mouse'! !

!TheWorldMenu methodsFor: '*PreferencesMenu-construction' stamp: 'KLG 9/1/2021 17:38:32'!
menusShowSubSectionTitles
	"Answer item strimg for this preference"
	
	^ Preferences menusShowSubSectionTitles asMenuItemTextPrefix,  'Menus show section titles'! !

!TheWorldMenu methodsFor: '*PreferencesMenu-popups' stamp: 'KLG 8/30/2021 10:58:26'!
openExtensionThemesMenu
	"Build and show the menu for extension themes."

	self doPopUp: self extensionThemesMenu ! !

!TheWorldMenu methodsFor: '*PreferencesMenu-popups' stamp: 'KLG 9/4/2021 12:28:14'!
openPreferencesMenuForCategory: aCategory
	"Create ans open the preferences menu for a category."

	self doPopUp: (self preferencesMenuForCategory: aCategory)! !

!TheWorldMenu methodsFor: '*PreferencesMenu-construction' stamp: 'KLG 9/4/2021 13:29:29'!
preferencesMenu
	"Build the preferences menu for the world."

	| menu |
	(menu _ self menu: 'Preferences...')
		addItemsFromDictionaries: {
			'Event handling'.
			{
				#label 			-> 		#focusFollowsMouse.
				#selector 			-> 		#toggleFocusFollowsMouse.
				#icon 			-> 		#windowIcon.
				#balloonText 	-> (
'If ', 'checked' bold, ', make the active window and widget the one on which the mouse is ', 'located' bold, '.
If ',' not checked' bold, ', make the active window and widget the one where the mouse was ', 'clicked' bold, '.'
								)
			} asDictionary.
			{
				#label 			-> 		#sendsMouseWheelEvents.
				#selector 			-> 		#toggleSendMouseWheelEvents.
				#icon 			-> 		#sendReceiveIcon.
				#balloonText 	-> (
'If ', 'checked' bold, ', the Virtual Machine sends ', 'real' bold,  ' mouse scroll wheel events.
If ',' not checked' bold, ' the Virtual Machine sends ','emulated' bold, ' key up and down events
and ', 'horizontal scrolling' bold, ' is ', 'disabled' bold, '!!'
								)
			} asDictionary.
			{
				#label 			-> 		#clickGrabsMorphs.
				#selector 			-> 		#toggleClickGrabsMorphs.
				#icon 			-> 		#sendReceiveIcon.
				#balloonText 	-> (
'If ', 'checked' bold, ', clicking on a morph ', 'drags' bold,  ' it.
If ',' not checked' bold, ' clicking on a morph just ','selects' bold, ' it.'
								)
			} asDictionary.
			'Fonts'.
			{
				#label 			-> 		'Size of GUI elements...'.
				#object 			-> 		Theme.
				#selector 			-> 		#changeFontSizes.
				#icon 			-> 		#preferencesDesktopFontIcon.
				#balloonText 	-> 		'use larger or smaller text and widgets'
			} asDictionary.
			{
				#label			->		'Set System Font...'.
				#object 			-> 		FontFamily.
				#selector 			-> 		#promptUserAndSetDefault.
				#icon 			-> 		#preferencesDesktopFontIcon.
				#balloonText 	-> 		'change the current system font family.'
			} asDictionary.
			{
				#label			->		'Load all TrueType Fonts'.
				#object 			-> 		FontFamily.
				#selector 			-> 		#readAdditionalTrueTypeFonts.
				#icon 			-> 		#preferencesDesktopFontIcon.
				#balloonText 	-> 		'Load additional TrueType fonts included with Cuis.'
			} asDictionary.
			'Menus'.
			{
				#label 			-> 		#wantsMenuIcons.
				#selector 			-> 		#toggleMenuIcons.
				#icon 			-> 		#worldIcon.
				#balloonText 	-> 		(
'If ', 'checked' bold, ', menus show ', 'icons' bold,  '
If ','not checked' bold, ' menus show just ','lines' bold, ' without icons'
								)
			} asDictionary.
			{
				#label 			-> 		#menusShowSubSectionTitles.
				#selector 			-> 		#toggleMenusShowSubSectionTitles.
				#balloonText 	->	(
'If ', 'checked' bold, ', menus show ', 'section titles' bold,  '
If ','not checked' bold, ' menus show just ','lines' bold
								)
			} asDictionary.
			'Themes' }.
	Theme addThemeChangersToMenu: menu forExtensionThemes: false.
	menu			
		addItemsFromDictionaries: {
			nil.
			{
				#label 			-> 		'Extension themes ...'.
				#selector 			-> 		#openExtensionThemesMenu.
				#icon 			-> 		#appearanceIcon.
				#balloonText 	-> 		'open the extension themes menu'
			} asDictionary.
			'Taskbar' }.
	TaskbarMorph addConfigurationOptionsToMenu: menu.
	menu
		addItemsFromDictionaries:  {
			'VM Window'.
			{
				#label 			-> 		'Full screen on'.
				#selector 			-> 		#fullScreenOn.
				#icon 			-> 		#viewFullscreenIcon.
				#balloonText 	-> 		'puts you in full-screen mode, if not already there.'
			} asDictionary.
			{
				#label 			-> 		'Full screen off'.
				#selector 			-> 		#fullScreenOff.
				#icon 			-> 		#exitFullscreenIcon.
				#balloonText 	-> 		'if in full-screen mode, takes you out of it.'
			} asDictionary.
			'Programming'.
			{
				#label 			-> 		'Set Code Author...'.
				#object 			-> 		Utilities.
				#selector 			-> 		#setAuthor.
				#icon 			-> 		#usersIcon.
				#balloonText 	-> 		'supply initials to be used to identify the author of code and other content.'
			} asDictionary.
			nil.
			{
				#label 			-> 		#autoNumberUserChanges.
				#selector 			-> 		#toggleAutoNumberUserChanges.
				#icon 			-> 		#usersIcon.
				#balloonText 	-> 		(
'Generate numbered user change files
(<image>.user.', '<number>' bold, '.changes)'
								)
			} asDictionary.
			{
				#label 			-> 		#changeSetVersionNumbers.
				#selector 			-> 		#toggleChangeSetVersionNumbers.
				#icon 			-> 		#usersIcon.
				#balloonText 	-> 		(
'Generate version numbered change set files
(<number>-<description>-<author>-<timestamp>-<initials>.', '<versionnumber>' bold, '.cs.st)'
								)
			} asDictionary.
			'Other'.
			{
				#label 			-> 		'Inspect preferences...'.
				#object 			-> 		Preferences.
				#selector 			-> 		#openPreferencesInspector.
				#icon 			-> 		#preferencesIcon.
				#balloonText 	-> 		'Open an inspector on all the preferences.'
			} asDictionary.
			{
				#label 			-> 		'Explore preferences...'.
				#object 			-> 		Preferences.
				#selector 			-> 		#openPreferencesExplorer.
				#icon 			-> 		#preferencesIcon.
				#balloonText 	-> 		'Open an explorer on all the preferences.'
			} asDictionary.
			nil
		}.
	Preferences booleanPreferenceCategories do: [ :category | 
		menu
			add: category, '...'
			target: self
			action: #openPreferencesMenuForCategory:
			argument: category ].
	^ menu
		! !

!TheWorldMenu methodsFor: '*PreferencesMenu-construction' stamp: 'KLG 9/4/2021 17:10:32'!
preferencesMenuForCategory: aCategory
	"Create the preferences menu for a category."

	| answer |
	answer _ self menu: aCategory, ' Preferences'.
	Preferences addBooleanItemsForCategory: aCategory toMenu: answer.
	^ answer! !

!TheWorldMenu methodsFor: '*PreferencesMenu-construction' stamp: 'KLG 9/1/2021 17:38:52'!
sendsMouseWheelEvents
	"Answer the item string for the send mouse scroll event stuff."
	
	^ Smalltalk sendMouseWheelEvents asMenuItemTextPrefix,  'Send mouse wheel events'! !

!TheWorldMenu methodsFor: '*PreferencesMenu-commands' stamp: 'KLG 9/1/2021 18:15:21'!
toggleAutoNumberUserChanges
	"Toogle automatic generation of user changes files.."
	
	Preferences 		togglePreference: #autoNumberUserChanges
	! !

!TheWorldMenu methodsFor: '*PreferencesMenu-commands' stamp: 'KLG 9/1/2021 18:15:00'!
toggleChangeSetVersionNumbers
	"Toggle the chnage set version numbers preference "
	
	Preferences togglePreference: #autoNumberUserChanges
	! !

!TheWorldMenu methodsFor: '*PreferencesMenu-commands' stamp: 'KLG 9/1/2021 18:41:00'!
toggleClickGrabsMorphs
	"Toogle the click grabs morph preference."
	
	^ Preferences togglePreference: #clickGrabsMorphs! !

!TheWorldMenu methodsFor: '*PreferencesMenu-commands' stamp: 'KLG 8/27/2021 23:02:57'!
toggleFocusFollowsMouse
	"Toggle the focus follows mouse menu'"
	
	Preferences focusFollowsMouse
		ifTrue: [ Preferences disableFocusFollowsMouse ]
		ifFalse: [ Preferences enableFocusFollowsMouse ]! !

!TheWorldMenu methodsFor: '*PreferencesMenu-commands' stamp: 'KLG 8/28/2021 22:49:22'!
toggleMenuIcons
	"Toggle the preference that controls menu icons"
	
	Preferences wantsMenuIcons
		ifTrue: [ Preferences useNoMenuIcons ]
		ifFalse: [ Preferences useMenuIcons ]! !

!TheWorldMenu methodsFor: '*PreferencesMenu-commands' stamp: 'KLG 8/28/2021 00:25:21'!
toggleMenusShowSubSectionTitles
	"Toggle the settings for menus showing subsection items."
	
	Preferences menusShowSubSectionTitles: Preferences menusShowSubSectionTitles not! !

!TheWorldMenu methodsFor: '*PreferencesMenu-commands' stamp: 'KLG 8/27/2021 23:50:48'!
toggleSendMouseWheelEvents
	"Toogle the mouse-wheel event settings."
	
	Smalltalk sendMouseWheelEvents: Smalltalk sendMouseWheelEvents not
	! !

!TheWorldMenu methodsFor: '*PreferencesMenu-construction' stamp: 'KLG 9/1/2021 17:37:11'!
wantsMenuIcons
	"Answer true when menus should have icons."
	
	^ Preferences wantsMenuIcons asMenuItemTextPrefix, 'Menus show icons'! !

!Theme class methodsFor: '*PreferencesMenu-user interface' stamp: 'KLG 8/30/2021 11:36:12'!
addThemeChangersToMenu: menu forExtensionThemes: anExtensionThemeFlag 
	"In Theme-Themes.pck.st"
	
	| extensionChecker |
	anExtensionThemeFlag ifTrue: [
		menu 
			add: 'Load additional themes'
			target:  Feature
			action: #require:
			argument: 'Theme-Themes'
			icon: self current packageIcon ::
				setBalloonText: 'Load the package with additional themes';
				isEnabled: (	FeatureRequirement name: 'Theme-Themes' :: isAlreadySatisfied not).
		menu
			addLine ].
	extensionChecker _ anExtensionThemeFlag
		ifFalse: [ [ :themeClass :block | themeClass package ifNil: block ] ]
		ifTrue: [ [ :themeClass :block | themeClass package ifNotNil: block ] ].
	(Theme allSubclasses sorted: [ :a :b | a name < b name ]) do: [ :themeClass |
		extensionChecker value: themeClass value: [
			menu 
				addUpdating: #themeMenuItemStringWithCheckBox
				target: themeClass 
				action: #beCurrent ::
					setBalloonText: themeClass themeBallonText ] ]! !

!Theme class methodsFor: '*PreferencesMenu-user interface' stamp: 'KLG 8/30/2021 10:39:51'!
themeBallonText
	"Answer the themes menu item string."

	^ 'Use the ', self themeMenuItemString bold, ' theme'! !

!Theme class methodsFor: '*PreferencesMenu-user interface' stamp: 'KLG 8/28/2021 23:21:51'!
themeMenuItemString
	"Answer the themes menu item string."

	^ self name! !

!Theme class methodsFor: '*PreferencesMenu-user interface' stamp: 'KLG 9/1/2021 17:54:53'!
themeMenuItemStringWithCheckBox
	"Answer my preferences menu item string with a checkbox."

	^ self == Theme current class :: asMenuItemTextPrefix,  self themeMenuItemString! !


More information about the Cuis-dev mailing list