Marcel Taeumel uploaded a new version of ToolBuilder-Morphic to project The Trunk:
http://source.squeak.org/trunk/ToolBuilder-Morphic-mt.270.mcz==================== Summary ====================
Name: ToolBuilder-Morphic-mt.270
Author: mt
Time: 11 January 2021, 5:36:43.295446 pm
UUID: 5171b75b-ee89-b14f-8ec9-a27cdfaa52bb
Ancestors: ToolBuilder-Morphic-mt.269
To pluggable dialogs, add an expand button if the model supports #preferredExtent. Also tweaks a list-chooser's initial extent show 5 to 15 items which each about 10 to 20 characters, depending on the list's content.
This commit addresses the concerns raised in ToolBuilder-Morphic-cbc.270 (inbox).
See
http://forum.world.st/The-Inbox-ToolBuilder-Morphic-cbc-270-mcz-tp5126045.html=============== Diff against ToolBuilder-Morphic-mt.269 ===============
Item was changed:
----- Method: ListChooser>>buildWith: (in category 'building') -----
buildWith: builder
| dialogSpec searchBarHeight listSpec fieldSpec |
+ searchBarHeight := self searchBarHeight.
- searchBarHeight := Preferences standardDefaultTextFont height * 1.75.
dialogSpec := builder pluggableDialogSpec new
model: self;
title: #title;
closeAction: #closed;
extent: self initialExtent;
autoCancel: true; "Behave like a pop-up menu. Historical reasons."
children: OrderedCollection new;
buttons: OrderedCollection new;
yourself.
listSpec := builder pluggableListSpec new.
listSpec
model: self;
list: #items;
getIndex: #selectedIndex;
setIndex: #selectedIndex:;
doubleClick: #accept;
"keystrokePreview: #keyStrokeFromList:;"
autoDeselect: false;
filterableList: true;
clearFilterAutomatically: false;
name: #list;
frame: (LayoutFrame fractions: (0@0 corner: 1@1) offsets: (0@searchBarHeight corner: 0@0)).
dialogSpec children add: listSpec.
fieldSpec := builder pluggableInputFieldSpec new.
fieldSpec
model: self;
name: #searchText ;
getText: #searchText;
editText: #searchText:;
setText: #acceptText:;
selection: #textSelection;
menu: nil;
indicateUnacceptedChanges: false;
askBeforeDiscardingEdits: false;
help: (self addAllowed ifTrue: ['Type new or filter existing...' translated] ifFalse: ['Type to filter existing...' translated]);
frame: (LayoutFrame fractions: (0@0 corner: 1@0) offsets: (0@0 corner: 0@searchBarHeight)).
dialogSpec children add: fieldSpec.
"Buttons"
dialogSpec buttons add: (
builder pluggableButtonSpec new
model: self;
label: #acceptLabel;
action: #accept;
enabled: #canAcceptOrAdd;
color: #acceptColor).
dialogSpec buttons add: (
builder pluggableButtonSpec new
model: self;
label: 'Cancel';
action: #cancel;
color: #cancelColor).
dialogMorph := builder build: dialogSpec.
dialogMorph addKeyboardCaptureFilter: self ; positionOverWidgetNamed: #searchText.
listMorph := builder widgetAt: #list.
listMorph allowEmptyFilterResult: true.
^ dialogMorph!
Item was changed:
----- Method: ListChooser>>initialExtent (in category 'building') -----
initialExtent
+ | listFont itemCount maxItemSize cellSize |
- | listFont |
listFont := Preferences standardListFont.
+ itemCount := items size.
+ maxItemSize := items inject: 0 into: [:max :item | max max: item size].
+ cellSize := (listFont widthOf: $m) @ listFont height.
+
+ ^ ((maxItemSize + 1 "breathing space" min: 20 max: 10)
+ @ (itemCount + 1 "breathing space" min: 15 max: 5)
+ * cellSize) + (0@ self searchBarHeight)!
- ^ (20 * (listFont widthOf: $m))@(15 * listFont height)!
Item was added:
+ ----- Method: ListChooser>>preferredExtent (in category 'building') -----
+ preferredExtent
+
+ | listFont cellSize |
+ listFont := Preferences standardListFont.
+ cellSize := (listFont widthOf: $m) @ listFont height.
+
+ ^ ((items inject: 0 into: [:max :item | max max: (listFont widthOfString: item)])
+ @ (items size * listFont height))
+ + ((1@1) * cellSize) "breathing space"
+ + (0@ self searchBarHeight)!
Item was added:
+ ----- Method: ListChooser>>searchBarHeight (in category 'building') -----
+ searchBarHeight
+
+ ^ Preferences standardDefaultTextFont height * 1.75!
Item was changed:
----- Method: ListMultipleChooser>>initialExtent (in category 'toolbuilder') -----
initialExtent
+ | listFont itemCount maxItemSize cellSize |
- | listFont |
listFont := Preferences standardListFont.
+ itemCount := labels size.
+ maxItemSize := labels inject: 0 into: [:max :item | max max: item size].
+ cellSize := (listFont widthOf: $m) @ listFont height.
+
+ ^ ((maxItemSize + 1 "breathing space" min: 20 max: 10)
+ @ (itemCount + 1 "breathing space" min: 15 max: 5)
+ * cellSize)!
- ^ (20 * (listFont widthOf: $m))@(15 * listFont height)!
Item was added:
+ ----- Method: ListMultipleChooser>>preferredExtent (in category 'toolbuilder') -----
+ preferredExtent
+
+ | listFont cellSize |
+ listFont := Preferences standardListFont.
+ cellSize := (listFont widthOf: $m) @ listFont height.
+
+ ^ ((labels inject: 0 into: [:max :item | max max: (listFont widthOfString: item)])
+ @ (labels size * listFont height))
+ + ((1@1) * cellSize) "breathing space"!
Item was changed:
----- Method: MorphicToolBuilder>>buildPluggableDialog: (in category 'widgets optional') -----
buildPluggableDialog: aSpec
| widget |
widget := self dialogClass new.
self register: widget id: aSpec name.
widget model: aSpec model.
"Set child dependent layout properties. The pane morph holds the special contents."
widget paneMorph wantsPaneSplitters: (aSpec wantsResizeHandles ifNil: [true]).
self setLayoutHintsFor: widget paneMorph spec: aSpec.
widget paneMorph layoutInset: (aSpec padding ifNil: [ProportionalSplitterMorph gripThickness]).
widget paneMorph cellGap: (aSpec spacing ifNil: [ProportionalSplitterMorph gripThickness]).
widget paneMorph wantsPaneSplitters ifTrue: [
widget paneMorph addCornerGrips"addEdgeGrips".
widget paneMorph grips do: [:ea | ea showHandle: true]].
"Now create the children."
panes := OrderedCollection new.
aSpec children isSymbol
ifTrue: [
widget getChildrenSelector: aSpec children.
widget update: aSpec children]
ifFalse: [
self buildAll: aSpec children in: widget paneMorph].
"Now create the buttons."
aSpec buttons isSymbol
ifTrue: [
widget getButtonsSelector: aSpec buttons.
widget update: aSpec buttons]
ifFalse: [
self buildAll: aSpec buttons in: widget buttonRowMorph.
widget updateButtonProperties].
aSpec title ifNotNil: [:label |
label isSymbol
ifTrue:[widget getTitleSelector: label; update: label]
ifFalse:[widget title: label]].
aSpec message ifNotNil: [:label |
label isSymbol
ifTrue:[widget getMessageSelector: label; update: label]
ifFalse:[widget message: label]].
"Interaction behavior."
aSpec autoCancel ifNotNil: [:b | widget autoCancel: b].
aSpec exclusive ifNotNil: [:b | widget exclusive: b].
widget closeDialogSelector: aSpec closeAction.
self buildHelpFor: widget spec: aSpec.
"Everything is shrink-wrapped around the pane morph."
+ widget paneMorph extent: (aSpec extent ifNil:[widget initialExtent])
+ + (widget paneMorph layoutInset * 2) asPoint.
- widget paneMorph extent: (aSpec extent ifNil:[widget initialExtent]).
^ widget!
Item was added:
+ ----- Method: PluggableDialogWindow>>createTitle: (in category 'initialization') -----
+ createTitle: aString
+ "Overridden to add an extra expand button. Yet, it depends on the model's interface whether that button will be visible. See #model:."
+
+ | box expandButton|
+ super createTitle: aString.
+
+ expandButton := SystemWindowButton new
+ name: #expandButton;
+ color: Color transparent;
+ target: self;
+ actionSelector: #expandDialogPane;
+ balloonText: 'Expand this dialog' translated;
+ borderWidth: 0;
+ yourself.
+ SystemWindow expandBoxImage scaleIconToDisplay in: [:icon |
+ expandButton labelGraphic: icon; extent: icon extent].
+
+ box := self submorphNamed: #title.
+ box addMorphBack: expandButton.!
Item was added:
+ ----- Method: PluggableDialogWindow>>expandDialogPane (in category 'running') -----
+ expandDialogPane
+ "Expand the dialog pane to its preferred extent. Honor the visible area in the world."
+
+ | visibleArea decorationOffset expandedExtent |
+ visibleArea := self currentWorld visibleClearArea.
+ decorationOffset := self extent - self paneMorph extent.
+ expandedExtent := self model preferredExtent + (self paneMorph layoutInset * 2) asPoint.
+
+ self paneMorph extent: (expandedExtent min: visibleArea extent - decorationOffset).
+
+ self fullBounds.
+ self moveToPreferredPosition.!
Item was changed:
----- Method: PluggableDialogWindow>>model: (in category 'accessing') -----
+ model: newModel
- model: anObject
model ifNotNil: [model removeDependent: self].
+ newModel ifNotNil: [
+ newModel addDependent: self.
+ (newModel respondsTo: #preferredExtent)
+ ifFalse: [((self submorphNamed: #title) submorphNamed: #expandButton) delete]].
+ model := newModel.!
- anObject ifNotNil: [anObject addDependent: self].
- model := anObject.!
Locked
