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