[Cuis-dev] [IMPROV] Preferences Menu With Better Feedback
Gerald Klix
cuis.01 at klix.ch
Mon Aug 30 05:54:10 PDT 2021
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
-------------- next part --------------
'From Haver 5.0 [latest update: #4815] on 30 August 2021 at 2:35:10 pm'!
'Description '!
!provides: 'PreferencesMenu' 1 10!
SystemOrganization addCategory: 'PreferencesMenu'!
!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! !
!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 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 8/27/2021 23:00:49'!
focusFollowsMouse
"Answer the label for focus follows mouse.."
^ Preferences focusFollowsMouse
ifTrue: [ '<Yes>' ] ifFalse: [ '<No>' ] :: , 'Focus follows mouse'! !
!TheWorldMenu methodsFor: '*PreferencesMenu-construction' stamp: 'KLG 8/30/2021 13:43:58'!
menusShowSubSectionTitles
"Answer item strimg for this preference"
^ Preferences menusShowSubSectionTitles
ifTrue: [ '<Yes>' ]
ifFalse: [ '<No>' ] :: , '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-construction' stamp: 'KLG 8/30/2021 13:43:53'!
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 -> #sendsMouyseWheelEvents.
#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.
'Fonts'.
{
#label -> 'Font Sizes...'.
#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.
'Other'.
{
#label -> 'All preferences...'.
#object -> Preferences.
#selector -> #openPreferencesInspector.
#icon -> #preferencesIcon.
#balloonText -> 'view and change various options.'
} asDictionary.
}.
^ menu
! !
!TheWorldMenu methodsFor: '*PreferencesMenu-construction' stamp: 'KLG 8/28/2021 00:57:08'!
sendsMouyseWheelEvents
"Answer the item string for the send mouse scroll event stuff."
^ Smalltalk sendMouseWheelEvents
ifTrue: [ '<Yes>' ]
ifFalse: [ '<No>' ] :: , 'Send mouse wheel events'! !
!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 8/28/2021 22:46:13'!
wantsMenuIcons
"Answer true when menus should have icons."
^ Preferences wantsMenuIcons
ifTrue: [ '<Yes>' ]
ifFalse: [ '<No>' ] :: , '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 8/30/2021 11:40:39'!
themeMenuItemStringWithCheckBox
"Answer my preferences menu item string with a checkbox."
^ self == Theme current class
ifTrue: [ '<Yes>' ]
ifFalse: [ '<No>' ] :: , self themeMenuItemString! !
More information about the Cuis-dev
mailing list