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.ht...
=============== 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.!
packages@lists.squeakfoundation.org