A new version of Morphic was added to project The Inbox:
http://source.squeak.org/inbox/Morphic-ct.1689.mcz

==================== Summary ====================

Name: Morphic-ct.1689
Author: ct
Time: 30 September 2020, 8:23:24.908605 pm
UUID: d37597bc-aeb8-354c-8500-bb8e4b5f5373
Ancestors: Morphic-eem.1686

If the label in a button is truncated, use it as fallback balloon text. Also speeds up drawing logic a little bit (but I did not measure the impact).

Snippets to quickly try out:
	(PluggableButtonMorphPlus on: PluggableTextMorphPlus new getState: #isNil action: #halt label: #yourself) openInHand
	(PluggableButtonMorphPlus on: 'foo\bar' withCRs getState: #isNil action: #halt label: #yourself) openInHand
Resize and hover them.

Originally inspired by this problem: http://forum.world.st/The-Inbox-Morphic-ct-1634-mcz-td5112623.html#a5112644:~:text=posts-,%3E%20Would%20like%20that%20the%20text%20on%20the%20buttons%20did%20not%20abbreviate%20down.,Hm%2C%20should%20the%20default%20balloon%20text%20for%20each%20button%20in%20Squeak%20be%20its%20content%20if%20abbreviated%3F

=============== Diff against Morphic-eem.1686 ===============

Item was changed:
  Morph subclass: #PluggableButtonMorph
+ 	instanceVariableNames: 'model label font getStateSelector actionSelector getLabelSelector getMenuSelector shortcutCharacter askBeforeChanging triggerOnMouseDown offColor onColor feedbackColor showSelectionFeedback allButtons arguments argumentsProvider argumentsSelector style hoverColor borderColor textColor labelOffset wantsGradient truncateLabel'
- 	instanceVariableNames: 'model label font getStateSelector actionSelector getLabelSelector getMenuSelector shortcutCharacter askBeforeChanging triggerOnMouseDown offColor onColor feedbackColor showSelectionFeedback allButtons arguments argumentsProvider argumentsSelector style hoverColor borderColor textColor labelOffset wantsGradient'
  	classVariableNames: 'GradientButton RoundedButtonCorners'
  	poolDictionaries: ''
  	category: 'Morphic-Pluggable Widgets'!
  
  !PluggableButtonMorph commentStamp: '<historical>' prior: 0!
  A PluggableButtonMorph is a combination of an indicator for a boolean value stored in its model and an action button. The action of a button is often, but not always, to toggle the boolean value that it shows. Its pluggable selectors are:
  
  		getStateSelector		fetch a boolean value from the model
  		actionSelector		invoke this button's action on the model
  		getLabelSelector		fetch this button's lable from the model
  		getMenuSelector		fetch a pop-up menu for this button from the model
  
  Any of the above selectors can be nil, meaning that the model does not supply behavior for the given action, and the default behavior should be used. For example, if getStateSelector is nil, then this button shows the state of a read-only boolean that is always false.
  
  The model informs its view(s) of changes by sending #changed: to itself with getStateSelector as a parameter. The view tells the model when the button is pressed by sending actionSelector.
  
  If the actionSelector takes one or more arguments, then the following are relevant:
  		arguments			A list of arguments to provide when the actionSelector is called.
  		argumentsProvider	The object that is sent the argumentSelector to obtain arguments, if dynamic
  		argumentsSelector	The message sent to the argumentProvider to obtain the arguments.
  
  Options:
  	askBeforeChanging		have model ask user before allowing a change that could lose edits
  	triggerOnMouseDown	do this button's action on mouse down (vs. up) transition
  	shortcutCharacter		a place to record an optional shortcut key
  !

Item was added:
+ ----- Method: PluggableButtonMorph>>balloonText (in category 'accessing') -----
+ balloonText
+ 
+ 	| labelToUse |
+ 	super balloonText ifNotNil: [:text | ^ text].
+ 	(truncateLabel ifNil: [false]) ifFalse: [^ nil].
+ 	
+ 	labelToUse := self label.
+ 	^ labelToUse isMorph
+ 		ifTrue: [Character startOfHeader asText
+ 			addAttribute: labelToUse asTextAnchor;
+ 			yourself]
+ 		ifFalse: [labelToUse asString]!

Item was changed:
  ----- Method: PluggableButtonMorph>>drawLabelOn: (in category 'drawing') -----
  drawLabelOn: aCanvas
  
  	| fontToUse labelToUse colorToUse labelWidth layoutBounds drawBlock |
  	self label ifNil: [^ self].
+ 	
- 
  	layoutBounds := self layoutBounds.
  	labelToUse := self label asString.
  	fontToUse := self font.
  	colorToUse := self textColorToUse.
  	
+ 	labelWidth := fontToUse widthOfString: labelToUse.
+ 	truncateLabel := labelWidth > layoutBounds width.
+ 	
  	"Support very narrow buttons. Shrink text to monogram then."
  	((layoutBounds width < self labelShrinkThreshold
  		and: [self hResizing ~~ #shrinkWrap])
  		and: [labelToUse size > 3]) ifTrue: [
  			labelToUse := labelToUse first asString. "Show first character only."
+ 			fontToUse := fontToUse emphasized: (TextEmphasis bold) emphasisCode.
+ 			labelWidth := fontToUse widthOfString: labelToUse].
- 			fontToUse := fontToUse emphasized: (TextEmphasis bold) emphasisCode].
  	
- 	labelWidth := fontToUse widthOfString: labelToUse.
- 
  	drawBlock := [:c | c
  			drawString: labelToUse
  			at: (layoutBounds center x - (labelWidth // 2) max: (layoutBounds left)) 
  				@ (layoutBounds center y - (fontToUse height // 2))
  			font: fontToUse
  			color: colorToUse].
+ 	
- 		
  	self clipSubmorphs
  		ifTrue: [aCanvas clipBy: layoutBounds during: drawBlock]
+ 		ifFalse: [drawBlock value: aCanvas].!
- 		ifFalse: [drawBlock value: aCanvas]!

Item was changed:
  ----- Method: PluggableButtonMorph>>drawMorphLabelOn: (in category 'drawing') -----
  drawMorphLabelOn: aCanvas
  
+ 	| layoutBounds labelToUse |
- 	| layoutBounds |
  	layoutBounds := self layoutBounds.
+ 	labelToUse := self label.
- 
- 	self label privateFullMoveBy: (layoutBounds center - self label center).
  	
+ 	truncateLabel := (labelToUse extent <= layoutBounds extent) not.
+ 	labelToUse privateFullMoveBy: layoutBounds center - labelToUse center.
+ 	
  	self clipSubmorphs
  		ifTrue: [aCanvas
  			clipBy: layoutBounds
+ 			during: [:c | c fullDrawMorph: labelToUse]]
+ 		ifFalse: [aCanvas fullDrawMorph: labelToUse].!
- 			during: [:c | c fullDrawMorph: self label]]
- 		ifFalse: [aCanvas fullDrawMorph: self label].!

Item was changed:
  ----- Method: PluggableButtonMorph>>veryDeepInner: (in category 'copying') -----
  veryDeepInner: deepCopier
  	"Copy all of my instance variables.  Some need to be not copied at all, but shared.  	Warning!!!!  Every instance variable defined in this class must be handled.  We must also implement veryDeepFixupWith:.  See DeepCopier class comment."
  
  super veryDeepInner: deepCopier.
  "model := model.		Weakly copied"
  label := label veryDeepCopyWith: deepCopier.
  "getStateSelector := getStateSelector.		a Symbol"
  "actionSelector := actionSelector.		a Symbol"
  "getLabelSelector := getLabelSelector.		a Symbol"
  "getMenuSelector := getMenuSelector.		a Symbol"
  shortcutCharacter := shortcutCharacter veryDeepCopyWith: deepCopier.
  askBeforeChanging := askBeforeChanging veryDeepCopyWith: deepCopier.
  triggerOnMouseDown := triggerOnMouseDown veryDeepCopyWith: deepCopier.
  offColor := offColor veryDeepCopyWith: deepCopier.
  onColor := onColor veryDeepCopyWith: deepCopier.
  feedbackColor := feedbackColor veryDeepCopyWith: deepCopier.
  hoverColor := hoverColor veryDeepCopyWith: deepCopier.
  borderColor := borderColor veryDeepCopyWith: deepCopier.
  textColor := textColor veryDeepCopyWith: deepCopier.
  labelOffset := labelOffset veryDeepCopyWith: deepCopier.
  allButtons := nil.		"a cache"
  arguments := arguments veryDeepCopyWith: deepCopier.
  argumentsProvider := argumentsProvider veryDeepCopyWith: deepCopier.
  "argumentsSelector := argumentsSelector.   a Symbol" 
+ style := style.  "a Symbol"
+ "truncateLabel := truncateLabel."!
- style := style.  "a Symbol"!