[squeak-dev] The Trunk: ToolBuilder-Morphic-mt.270.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Jan 11 16:36:44 UTC 2021


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 at 0 corner: 1 at 1) offsets: (0 at searchBarHeight corner: 0 at 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 at 0 corner: 1 at 0) offsets: (0 at 0 corner: 0 at 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 at 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 at 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.!



More information about the Squeak-dev mailing list