[Pkg] The Trunk: Morphic-mt.1871.mcz

[commits at source.squeak.org]

Marcel Taeumel uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-mt.1871.mcz

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

Name: Morphic-mt.1871
Author: mt
Time: 5 February 2022, 5:50:07.252947 pm
UUID: ace9011c-de05-9846-b208-cccb9d5232a8
Ancestors: Morphic-mt.1870

Adds support for font changes in list items. Use it to spice up the "set style..." dialog in text fields.

=============== Diff against Morphic-mt.1870 ===============

Item was changed:
  ----- Method: LazyListMorph>>display:atRow:on: (in category 'drawing') -----
  display: item atRow: row on: canvas
  	"display the given item at row row"
  
  	| drawBounds leading emphasized rowColor itemAsText alignment |
  	itemAsText := item asStringOrText.
  	alignment := self cellPositioning.
  	
  	"If it is a text, we will only use the first character's emphasis."
+ 	emphasized := itemAsText isText
+ 		ifFalse: [ font "fast path" ]
+ 		ifTrue: [ "Note that a font change may interfere with the receiver's uniform item height."
+ 			(itemAsText
+ 				fontAt: 1 withDefault: font)
+ 				emphasized: (itemAsText emphasisAt: 1)].
- 	emphasized := itemAsText isText 
- 		ifTrue: [font emphasized: (itemAsText emphasisAt: 1)] 
- 		ifFalse: [font].
  	
  	rowColor := itemAsText isText
  		ifTrue: [itemAsText colorAt: 1 ifNone: [self colorForRow: row]]
  		ifFalse: [self colorForRow: row].
  	
  	drawBounds := self drawBoundsForRow: row.
  	
  	alignment ~= #leftCenter ifTrue: [
  		| itemWidth |
  		itemWidth := self widthToDisplayItem: item. "includes left/right margins"
  		alignment == #center ifTrue: [
  			drawBounds := (self center x - (itemWidth / 2) floor) @ drawBounds top corner: (self center x + (itemWidth / 2) ceiling) @ drawBounds bottom].
  		alignment == #rightCenter ifTrue: [
  			drawBounds := (self right - itemWidth) @ drawBounds top corner: self right @ drawBounds bottom]].
  
  	"Draw icon if existing. Adjust draw bounds in that case."
  	drawBounds := drawBounds translateBy: (self cellInset left @ 0).
  	(self icon: row) ifNotNil: [ :icon || top |
  		top := drawBounds top + ((drawBounds height - self iconExtent y) // 2).
  		canvas translucentImage: icon at: drawBounds left @ top.
  		drawBounds := drawBounds left: drawBounds left + self iconExtent x + self cellInset left ].
  		
  	"We will only draw strings here."
  	leading :=  emphasized lineGapSliceForMorphs. "look vertically centered"
  	drawBounds := drawBounds translateBy: (0 @ self cellInset top).
  	canvas
  		drawString: itemAsText asString
  		in: (drawBounds origin + (0 @ leading) corner: drawBounds corner)
  		font: emphasized
  		color: rowColor.
  
  	"Draw filter matches if any."
  	self
  		displayFilterOn: canvas
  		for: row
  		in: drawBounds
  		font: emphasized.!

Item was changed:
  ----- Method: TextEditor>>changeStyle (in category 'attributes') -----
  changeStyle
  	"Let user change styles for the current text pane."
- 	| names reply style current menuList |
  
+ 	| known knownTTCStyles knownLegacyStyles defaultStyles
+ 	newStyle current currentName menuList |
  	current := morph textStyle.
+ 	currentName := current defaultFamilyName.
+ 	
+ 	knownTTCStyles := ((TextStyle actualTextStyles select: [:ea | ea isTTCStyle])
+ 		sorted: [:a :b | a defaultFamilyName <= b defaultFamilyName])
+ 		collect: [:ea | ea defaultFamilyName -> ea] as: OrderedDictionary.
+ 	knownLegacyStyles := ((TextStyle actualTextStyles reject: [:ea | ea isTTCStyle])
+ 		sorted: [:a :b | a defaultFamilyName <= b defaultFamilyName])
+ 		collect: [:ea | ea defaultFamilyName -> ea] as: OrderedDictionary.
+ 	defaultStyles := ((TextStyle defaultFamilyNames
+ 		collect: [:ea | ea -> (TextStyle named: ea)] as: OrderedDictionary)
+ 		reject: [:ea | ea isNil "undefined default styles"])
+ 		sorted: [:a :b | a key <= b key].
+ 	
+ 	known := defaultStyles, {'---' -> nil}, knownTTCStyles, {'--- ' -> nil}, knownLegacyStyles.
+ 	menuList := Array streamContents: [:s |
+ 		known keysAndValuesDo: [ :knownName :knownStyle |
+ 			s nextPut: (((knownStyle notNil and: [knownStyle defaultFamilyName = currentName])
+ 				ifTrue: [ (' > ', knownName, ' (current)' translated) asText ]
+ 				ifFalse: [ knownName asText ]) addAttribute: (TextFontReference toFont: (knownStyle ifNil: [TextStyle default])defaultFont); yourself)]].
+ 	known := known values.
+ 	newStyle := Project uiManager chooseFrom: menuList values: known.
+ 	newStyle ifNotNil: [morph textStyle: newStyle copy].
- 	names := TextStyle knownTextStyles.
- 	menuList := names collect: [ :styleName |
- 		styleName = current name
- 			ifTrue: [ '<on>', styleName ]
- 			ifFalse: [ '<off>', styleName ]].
- 	reply := Project uiManager chooseFrom: menuList values: names.
- 	reply ifNotNil: [
- 		(style := TextStyle named: reply) ifNil: [Beeper beep. ^ true].
- 		morph textStyle: style copy].
  	^ true!