The Trunk: Morphic-fbs.674.mcz

Frank Shearar uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-fbs.674.mcz

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

Name: Morphic-fbs.674
Author: fbs
Time: 23 July 2013, 8:19:08.276 pm
UUID: 64910e8e-45f5-1248-b74d-5c66938bf1c5
Ancestors: Morphic-dtl.673

Break Graphics -> Morphic dependency. Push some UI-independent code down from Morphic into Graphics, and move extension-y things up into Morphic.

=============== Diff against Morphic-dtl.673 ===============

Item was added:
+ ----- Method: CompositionScanner>>composeFrom:inRectangle:firstLine:leftSide:rightSide: (in category '*Morphic-Text') -----
+ composeFrom: startIndex inRectangle: lineRectangle
+ firstLine: firstLine leftSide: leftSide rightSide: rightSide
+ "Answer an instance of TextLineInterval that represents the next line in the paragraph."
+ | runLength stopCondition |
+ "Set up margins"
+ leftMargin := lineRectangle left.
+ leftSide ifTrue: [leftMargin := leftMargin +
+ (firstLine ifTrue: [textStyle firstIndent]
+ ifFalse: [textStyle restIndent])].
+ destX := spaceX := leftMargin.
+ rightMargin := lineRectangle right.
+ rightSide ifTrue: [rightMargin := rightMargin - textStyle rightIndent].
+ lastIndex := startIndex. "scanning sets last index"
+ destY := lineRectangle top.
+ lineHeight := baseline := 0.  "Will be increased by setFont"
+ line := (TextLine start: lastIndex stop: 0 internalSpaces: 0 paddingWidth: 0)
+ rectangle: lineRectangle.
+ self setStopConditions. "also sets font"
+ runLength := text runLengthFor: startIndex.
+ runStopIndex := (lastIndex := startIndex) + (runLength - 1).
+ spaceCount := 0.
+ self handleIndentation.
+ leftMargin := destX.
+ line leftMargin: leftMargin.
+
+ [stopCondition := self scanCharactersFrom: lastIndex to: runStopIndex
+ in: text string rightX: rightMargin stopConditions: stopConditions
+ kern: kern.
+ "See setStopConditions for stopping conditions for composing."
+ (self perform: stopCondition)
+ ifTrue: [^ line lineHeight: lineHeight + textStyle leading
+ baseline: baseline + textStyle leading]] repeat!

Item was added:
+ ----- Method: DisplayScreen>>defaultCanvasClass (in category '*Morphic-blitter defaults') -----
+ defaultCanvasClass
+ "Return the WarpBlt version to use when I am active"
+ ^FormCanvas!

Item was added:
+ ----- Method: DisplayText>>composeForm (in category '*Morphic-Text') -----
+ composeForm
+ "For the TT strings in MVC widgets in a Morphic world such as a progress bar, the form is created by Morphic machinery."
+ | canvas tmpText |
+ Smalltalk isMorphic
+ ifTrue:
+ [tmpText := TextMorph new contentsAsIs: text deepCopy.
+ foreColor ifNotNil: [tmpText text addAttribute: (TextColor color: foreColor)].
+ backColor ifNotNil: [tmpText backgroundColor: backColor].
+ tmpText setTextStyle: textStyle.
+ canvas := FormCanvas on: (Form extent: tmpText extent depth: 32).
+ tmpText drawOn: canvas.
+ form := canvas form.
+ ]
+ ifFalse: [form := self asParagraph asForm]!

Item was removed:
- Object subclass: #TextComposer
- instanceVariableNames: 'lines maxRightX currentY scanner possibleSlide nowSliding prevIndex prevLines currCharIndex startCharIndex stopCharIndex deltaCharIndex theText theContainer isFirstLine theTextStyle defaultLineHeight actualHeight wantsColumnBreaks'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Text Support'!

Item was removed:
- ----- Method: TextComposer class>>characterForColumnBreak (in category 'as yet unclassified') -----
- characterForColumnBreak
-
- ^Character value: 12!

Item was removed:
- ----- Method: TextComposer>>addNullLineForIndex: (in category 'as yet unclassified') -----
- addNullLineForIndex: index
- "This awful bit is to ensure that if we have scanned all the text and the last character is a CR that there is a null line at the end of lines. Sometimes this was not happening which caused anomalous selections when selecting all the text. This is implemented as a post-composition fixup because I couldn't figure out where to put it in the main logic."
-
- | oldLastLine r |
-
- oldLastLine := lines last.
- oldLastLine last - oldLastLine first >= 0 ifFalse: [^self].
- oldLastLine last = (index - 1) ifFalse: [^self].
-
- r := oldLastLine left @ oldLastLine bottom
- extent: 0@(oldLastLine bottom - oldLastLine top).
- "Even though we may be below the bottom of the container,
- it is still necessary to compose the last line for consistency..."
-
- self addNullLineWithIndex: index andRectangle: r.
- !

Item was removed:
- ----- Method: TextComposer>>addNullLineWithIndex:andRectangle: (in category 'as yet unclassified') -----
- addNullLineWithIndex: index andRectangle: r
-
- lines addLast: (
- (
- TextLine
- start: index
- stop: index - 1
- internalSpaces: 0
- paddingWidth: 0
- )
- rectangle: r;
- lineHeight: defaultLineHeight baseline: theTextStyle baseline
- )
- !

Item was removed:
- ----- Method: TextComposer>>checkIfReadyToSlide (in category 'as yet unclassified') -----
- checkIfReadyToSlide
-
- "Check whether we are now in sync with previously composed lines"
-
- (possibleSlide and: [currCharIndex > stopCharIndex]) ifFalse: [^self].
-
- [prevIndex < prevLines size
- and: [(prevLines at: prevIndex) first < (currCharIndex - deltaCharIndex)]]
- whileTrue: [prevIndex := prevIndex + 1].
-
- (prevLines at: prevIndex) first = (currCharIndex - deltaCharIndex) ifTrue: [
- "Yes -- next line will have same start as prior line."
- prevIndex := prevIndex - 1.
- possibleSlide := false.
- nowSliding := true
- ] ifFalse: [
- prevIndex = prevLines size ifTrue: [
- "Weve reached the end of prevLines, so no use to keep looking for lines to slide."
- possibleSlide := false
- ]
- ]!

Item was removed:
- ----- Method: TextComposer>>composeAllLines (in category 'as yet unclassified') -----
- composeAllLines
-
- [currCharIndex <= theText size and:
- [(currentY + defaultLineHeight) <= theContainer bottom]] whileTrue: [
-
- nowSliding ifTrue: [
- self slideOneLineDown ifNil: [^nil].
- ] ifFalse: [
- self composeOneLine ifNil: [^nil].
- ]
- ].
- !

Item was removed:
- ----- Method: TextComposer>>composeAllRectangles: (in category 'as yet unclassified') -----
- composeAllRectangles: rectangles
-
- | charIndexBeforeLine numberOfLinesBefore reasonForStopping |
-
- actualHeight := defaultLineHeight.
- charIndexBeforeLine := currCharIndex.
- numberOfLinesBefore := lines size.
- reasonForStopping := self composeEachRectangleIn: rectangles.
-
- currentY := currentY + actualHeight.
- currentY > theContainer bottom ifTrue: [
- "Oops -- the line is really too high to fit -- back out"
- currCharIndex := charIndexBeforeLine.
- lines size - numberOfLinesBefore timesRepeat: [lines removeLast].
- ^self
- ].
-
- "It's OK -- the line still fits."
- maxRightX := maxRightX max: scanner rightX.
- 1 to: rectangles size - 1 do: [ :i | |lineIndex|
- "Adjust heights across rectangles if necessary"
- lineIndex:=lines size - rectangles size + i.
- (lines size between: 1 and: lineIndex) ifTrue:
- [(lines at: lineIndex)
- lineHeight: lines last lineHeight
- baseline: lines last baseline]
- ].
- isFirstLine := false.
- reasonForStopping == #columnBreak ifTrue: [^nil].
- currCharIndex > theText size ifTrue: [
- ^nil "we are finished composing"
- ].
- !

Item was removed:
- ----- Method: TextComposer>>composeEachRectangleIn: (in category 'as yet unclassified') -----
- composeEachRectangleIn: rectangles
-
- | myLine lastChar |
-
- 1 to: rectangles size do: [:i |
- currCharIndex <= theText size ifFalse: [^false].
- myLine := scanner
- composeFrom: currCharIndex
- inRectangle: (rectangles at: i)
- firstLine: isFirstLine
- leftSide: i=1
- rightSide: i=rectangles size.
- lines addLast: myLine.
- actualHeight := actualHeight max: myLine lineHeight.  "includes font changes"
- currCharIndex := myLine last + 1.
- lastChar := theText at: myLine last.
- (CharacterSet crlf includes: lastChar) ifTrue: [^#cr].
- wantsColumnBreaks ifTrue: [
- lastChar = TextComposer characterForColumnBreak ifTrue: [^#columnBreak].
- ].
- ].
- ^false!

Item was removed:
- ----- Method: TextComposer>>composeLinesFrom:to:delta:into:priorLines:atY:textStyle:text:container:wantsColumnBreaks: (in category 'as yet unclassified') -----
- composeLinesFrom: argStart to: argStop delta: argDelta into: argLinesCollection priorLines: argPriorLines atY: argStartY textStyle: argTextStyle text: argText container: argContainer wantsColumnBreaks: argWantsColumnBreaks
-
- wantsColumnBreaks := argWantsColumnBreaks.
- lines := argLinesCollection.
- theTextStyle := argTextStyle.
- theText := argText.
- theContainer := argContainer.
- deltaCharIndex := argDelta.
- currCharIndex := startCharIndex := argStart.
- stopCharIndex := argStop.
- prevLines := argPriorLines.
- currentY := argStartY.
- maxRightX := theContainer left.
- possibleSlide := stopCharIndex < theText size and: [theContainer isMemberOf: Rectangle].
- nowSliding := false.
- prevIndex := 1.
- scanner := CompositionScanner new text: theText textStyle: theTextStyle.
- scanner wantsColumnBreaks: wantsColumnBreaks.
- defaultLineHeight := scanner canComputeDefaultLineHeight
- ifTrue: [ scanner computeDefaultLineHeight ]
- ifFalse: [ theTextStyle lineGrid. ].
- isFirstLine := true.
- self composeAllLines.
- isFirstLine ifTrue: ["No space in container or empty text"
- self
- addNullLineWithIndex: startCharIndex
- andRectangle: (theContainer topLeft extent: 0@defaultLineHeight)
- ] ifFalse: [
- self fixupLastLineIfCR
- ].
- ^{lines asArray. maxRightX}
-
- !

Item was removed:
- ----- Method: TextComposer>>composeOneLine (in category 'as yet unclassified') -----
- composeOneLine
- | rectangles |
- rectangles := theContainer rectanglesAt: currentY height: defaultLineHeight.
- rectangles notEmpty
- ifTrue: [(self composeAllRectangles: rectangles) ifNil: [^nil]]
- ifFalse: [currentY := currentY + defaultLineHeight].
- self checkIfReadyToSlide!

Item was removed:
- ----- Method: TextComposer>>fixupLastLineIfCR (in category 'as yet unclassified') -----
- fixupLastLineIfCR
- "This awful bit is to ensure that if we have scanned all the text and the last character is a CR that there is a null line at the end of lines. Sometimes this was not happening which caused anomalous selections when selecting all the text. This is implemented as a post-composition fixup because I couldn't figure out where to put it in the main logic."
-
- (theText size > 0 and: [CharacterSet crlf includes: theText last]) ifFalse: [^self].
- self addNullLineForIndex: theText size + 1.
- !

Item was removed:
- ----- Method: TextComposer>>slideOneLineDown (in category 'as yet unclassified') -----
- slideOneLineDown
-
- | priorLine |
-
- "Having detected the end of rippling recoposition, we are only sliding old lines"
- prevIndex < prevLines size ifFalse: [
- "There are no more prevLines to slide."
- ^nowSliding := possibleSlide := false
- ].
-
- "Adjust and re-use previously composed line"
- prevIndex := prevIndex + 1.
- priorLine := (prevLines at: prevIndex)
- slideIndexBy: deltaCharIndex andMoveTopTo: currentY.
- lines addLast: priorLine.
- currentY := priorLine bottom.
- currCharIndex := priorLine last + 1.
- wantsColumnBreaks ifTrue: [
- priorLine first to: priorLine last do: [ :i |
- (theText at: i) = TextComposer characterForColumnBreak ifTrue: [
- nowSliding := possibleSlide := false.
- ^nil
- ].
- ].
- ].
- !

Item was removed:
- Object subclass: #TextLine
- instanceVariableNames: 'left right top bottom firstIndex lastIndex internalSpaces paddingWidth baseline leftMargin'
- classVariableNames: ''
- poolDictionaries: 'TextConstants'
- category: 'Morphic-Text Support'!
-
- !TextLine commentStamp: '<historical>' prior: 0!
- A TextLine embodies the layout of a line of composed text.
- left right top bottom The full line rectangle
- firstIndex lastIndex Starting and stopping indices in the full text
- internalSpaces Number of spaces to share paddingWidth
- paddingWidth Number of pixels of extra space in full line
- baseline Distance of baseline below the top of the line
- leftMargin Left margin due to paragraph indentation
- TextLine's rather verbose message protocol is required for compatibility with the old CharacterScanners.!

Item was removed:
- ----- Method: TextLine class>>start:stop:internalSpaces:paddingWidth: (in category 'instance creation') -----
- start: startInteger stop: stopInteger internalSpaces: spacesInteger paddingWidth: padWidthInteger
- "Answer an instance of me with the arguments as the start, stop points,
- number of spaces in the line, and width of the padding."
- | line |
- line := self new firstIndex: startInteger lastIndex: stopInteger.
- ^ line internalSpaces: spacesInteger paddingWidth: padWidthInteger!

Item was removed:
- ----- Method: TextLine>>= (in category 'comparing') -----
- = line
-
- self species = line species
- ifTrue: [^((firstIndex = line first and: [lastIndex = line last])
- and: [internalSpaces = line internalSpaces])
- and: [paddingWidth = line paddingWidth]]
- ifFalse: [^false]!

Item was removed:
- ----- Method: TextLine>>baseline (in category 'accessing') -----
- baseline
- ^ baseline!

Item was removed:
- ----- Method: TextLine>>bottom (in category 'accessing') -----
- bottom
- ^ bottom!

Item was removed:
- ----- Method: TextLine>>bottomRight (in category 'accessing') -----
- bottomRight
- ^ right@bottom!

Item was removed:
- ----- Method: TextLine>>first (in category 'accessing') -----
- first
- ^ firstIndex!

Item was removed:
- ----- Method: TextLine>>firstIndex:lastIndex: (in category 'private') -----
- firstIndex: firstInteger lastIndex: lastInteger
- firstIndex := firstInteger.
- lastIndex := lastInteger!

Item was removed:
- ----- Method: TextLine>>hash (in category 'comparing') -----
- hash
- "#hash is re-implemented because #= is re-implemented"
- ^firstIndex hash bitXor: lastIndex hash!

Item was removed:
- ----- Method: TextLine>>internalSpaces (in category 'accessing') -----
- internalSpaces
- "Answer the number of spaces in the line."
-
- ^internalSpaces!

Item was removed:
- ----- Method: TextLine>>internalSpaces: (in category 'accessing') -----
- internalSpaces: spacesInteger
- "Set the number of spaces in the line to be spacesInteger."
-
- internalSpaces := spacesInteger!

Item was removed:
- ----- Method: TextLine>>internalSpaces:paddingWidth: (in category 'private') -----
- internalSpaces: spacesInteger paddingWidth: padWidthInteger
-
- internalSpaces := spacesInteger.
- paddingWidth := padWidthInteger!

Item was removed:
- ----- Method: TextLine>>justifiedPadFor: (in category 'scanning') -----
- justifiedPadFor: spaceIndex
- "Compute the width of pad for a given space in a line of justified text."
-
- | pad |
- internalSpaces = 0 ifTrue: [^0].
- pad := paddingWidth // internalSpaces.
- spaceIndex <= (paddingWidth \\ internalSpaces)
- ifTrue: [^pad + 1]
- ifFalse: [^pad]!

Item was removed:
- ----- Method: TextLine>>justifiedPadFor:font: (in category 'scanning') -----
- justifiedPadFor: spaceIndex font: aFont
- "Compute the width of pad for a given space in a line of justified text."
-
- | pad |
- internalSpaces = 0 ifTrue: [^0].
- ^(aFont notNil and:[aFont isSubPixelPositioned])
- ifTrue:[paddingWidth * 1.0 / internalSpaces]
- ifFalse:[
- pad := paddingWidth // internalSpaces.
- spaceIndex <= (paddingWidth \\ internalSpaces)
- ifTrue: [pad + 1]
- ifFalse: [pad]]
- !

Item was removed:
- ----- Method: TextLine>>justifiedTabDeltaFor: (in category 'scanning') -----
- justifiedTabDeltaFor: spaceIndex
- "Compute the delta for a tab in a line of justified text, so tab falls
- somewhere plausible when line is justified."
-
- | pad extraPad |
- internalSpaces = 0 ifTrue: [^0].
- pad := paddingWidth // internalSpaces.
- extraPad := paddingWidth \\ internalSpaces.
- spaceIndex <= extraPad
- ifTrue: [^spaceIndex * (pad + 1)]
- ifFalse: [^extraPad * (pad + 1) + (spaceIndex - extraPad * pad)]!

Item was removed:
- ----- Method: TextLine>>last (in category 'accessing') -----
- last
- ^ lastIndex!

Item was removed:
- ----- Method: TextLine>>left (in category 'accessing') -----
- left
- ^ left!

Item was removed:
- ----- Method: TextLine>>leftMargin (in category 'accessing') -----
- leftMargin
- "This has to get fixed -- store during composition"
- ^ self left!

Item was removed:
- ----- Method: TextLine>>leftMargin: (in category 'accessing') -----
- leftMargin: lm
- left := lm!

Item was removed:
- ----- Method: TextLine>>leftMarginForAlignment: (in category 'accessing') -----
- leftMarginForAlignment: alignmentCode
- alignmentCode = RightFlush ifTrue: [^ self left + paddingWidth].
- alignmentCode = Centered ifTrue: [^ self left + (paddingWidth//2)].
- ^ self left  "leftFlush and justified"!

Item was removed:
- ----- Method: TextLine>>lineHeight (in category 'accessing') -----
- lineHeight
- ^ bottom - top!

Item was removed:
- ----- Method: TextLine>>lineHeight:baseline: (in category 'private') -----
- lineHeight: height baseline: ascent
- bottom := top + height.
- baseline := ascent!

Item was removed:
- ----- Method: TextLine>>moveBy: (in category 'updating') -----
- moveBy: delta
- "Move my rectangle by the given delta"
- left := left + delta x.
- right := right + delta x.
- top := top + delta y.
- bottom := bottom + delta y.
- !

Item was removed:
- ----- Method: TextLine>>paddingWidth (in category 'accessing') -----
- paddingWidth
- "Answer the amount of space to be added to the font."
-
- ^paddingWidth!

Item was removed:
- ----- Method: TextLine>>paddingWidth: (in category 'accessing') -----
- paddingWidth: padWidthInteger
- "Set the amount of space to be added to the font to be padWidthInteger."
-
- paddingWidth := padWidthInteger!

Item was removed:
- ----- Method: TextLine>>printOn: (in category 'printing') -----
- printOn: aStream
- super printOn: aStream.
- aStream space; print: firstIndex; nextPutAll: ' to: '; print: lastIndex!

Item was removed:
- ----- Method: TextLine>>rectangle (in category 'accessing') -----
- rectangle
- ^ self topLeft corner: self bottomRight!

Item was removed:
- ----- Method: TextLine>>rectangle: (in category 'accessing') -----
- rectangle: lineRectangle
- left := lineRectangle left.
- right := lineRectangle right.
- top := lineRectangle top.
- bottom := lineRectangle bottom!

Item was removed:
- ----- Method: TextLine>>right (in category 'accessing') -----
- right
- ^ right!

Item was removed:
- ----- Method: TextLine>>rightMargin (in category 'accessing') -----
- rightMargin
- "This has to get fixed -- store during composition"
- ^ self right!

Item was removed:
- ----- Method: TextLine>>setRight: (in category 'accessing') -----
- setRight: x
- right := x!

Item was removed:
- ----- Method: TextLine>>slide: (in category 'updating') -----
- slide: delta
- "Change the starting and stopping points of the line by delta."
-
- firstIndex := firstIndex + delta.
- lastIndex := lastIndex + delta!

Item was removed:
- ----- Method: TextLine>>slideIndexBy:andMoveTopTo: (in category 'updating') -----
- slideIndexBy: delta andMoveTopTo: newTop
- "Relocate my character indices and y-values.
- Used to slide constant text up or down in the wake of a text replacement."
-
- firstIndex := firstIndex + delta.
- lastIndex := lastIndex + delta.
- bottom := bottom + (newTop - top).
- top := newTop.
- !

Item was removed:
- ----- Method: TextLine>>stop: (in category 'accessing') -----
- stop: stopInteger
- "Set the stopping point in the string of the line to be stopInteger."
-
- lastIndex := stopInteger!

Item was removed:
- ----- Method: TextLine>>top (in category 'accessing') -----
- top
- ^ top!

Item was removed:
- ----- Method: TextLine>>topLeft (in category 'accessing') -----
- topLeft
- ^ left @ top!

Item was removed:
- ----- Method: TextLine>>width (in category 'accessing') -----
- width
- ^ right - left!

Item was added:
+ ----- Method: TextStyle class>>emphasisMenuForFont:target:selector:highlight: (in category '*Morphic-user interface') -----
+ emphasisMenuForFont: font target: target selector: selector highlight: currentEmphasis
+ "Offer a font emphasis menu for the given style. If one is selected, pass that font to target with a call to selector. The fonts will be displayed in that font.
+ Answer nil if no derivatives exist.
+ "
+
+   | aMenu derivs |
+ derivs := font derivativeFonts.
+ derivs isEmpty ifTrue: [ ^nil ].
+ aMenu := MenuMorph entitled: 'emphasis' translated.
+ derivs := derivs asOrderedCollection.
+ derivs addFirst: font.
+ derivs do: [ :df |
+ aMenu
+ add: df emphasisString
+ target: target
+ selector: selector
+ argument: df.
+                 aMenu lastItem font: df.
+                 df emphasis == currentEmphasis ifTrue: [aMenu lastItem color: Color blue darker]].
+         ^ aMenu!

Item was added:
+ ----- Method: TextStyle class>>fontMenuForStyle:target:selector: (in category '*Morphic-user interface') -----
+ fontMenuForStyle: styleName target: target selector: selector
+ ^self fontMenuForStyle: styleName target: target selector: selector highlight: nil!

Item was added:
+ ----- Method: TextStyle class>>fontMenuForStyle:target:selector:highlight: (in category '*Morphic-user interface') -----
+ fontMenuForStyle: styleName target: target selector: selector highlight: currentFont
+ "Offer a font menu for the given style. If one is selected, pass
+ that font to target with a  
+ call to selector. The fonts will be displayed in that font."
+ | aMenu |
+ aMenu := MenuMorph entitled: styleName.
+ (TextStyle named: styleName)
+ ifNotNil: [:s | s isTTCStyle
+ ifTrue: [aMenu
+ add: 'New Size'
+ target: self
+ selector: #chooseTTCFontSize:
+ argument: {styleName. target. selector}]].
+ (self pointSizesFor: styleName)
+ do: [:pointSize |
+ | font subMenu displayFont |
+ font := (self named: styleName)
+ fontOfPointSize: pointSize.
+ subMenu := self
+ emphasisMenuForFont: font
+ target: target
+ selector: selector
+ highlight: (currentFont
+ ifNotNil: [:cf | (cf familyName = styleName
+ and: [cf pointSize = font pointSize])
+ ifTrue: [currentFont emphasis]]).
+ subMenu
+ ifNil: [aMenu
+ add: pointSize asString , ' Point'
+ target: target
+ selector: selector
+ argument: font]
+ ifNotNil: [aMenu add: pointSize asString , ' Point' subMenu: subMenu].
+ displayFont := font.
+ (font isSymbolFont or:[(font hasDistinctGlyphsForAll: pointSize asString , ' Point') not])
+ ifTrue:[
+ "don't use a symbol font to display its own name!!!!"
+ displayFont := self default fontOfPointSize: pointSize].
+ aMenu lastItem font: displayFont.
+ currentFont
+ ifNotNil: [:cf | (cf familyName = styleName
+ and: [cf pointSize = font pointSize])
+ ifTrue: [aMenu lastItem color: Color blue darker]]].
+ ^ aMenu!

Item was added:
+ ----- Method: TextStyle class>>fontSizeSummary (in category '*Morphic-user interface') -----
+ fontSizeSummary
+ "Open a text window with a simple summary of the available sizes in each of the fonts in the system."
+
+ "TextStyle fontSizeSummary"
+ | aString aList |
+ aList := self knownTextStyles.
+ aString := String streamContents:
+ [:aStream |
+ aList do: [:aStyleName |
+ aStream nextPutAll:
+ aStyleName, '  ',
+ (self fontPointSizesFor: aStyleName) asArray storeString.
+ aStream cr]].
+ (StringHolder new contents: aString)
+ openLabel: 'Font styles and sizes' translated!

Item was added:
+ ----- Method: TextStyle class>>promptForFont:andSendTo:withSelector: (in category '*Morphic-user interface') -----
+ promptForFont: aPrompt andSendTo: aTarget withSelector: aSelector
+ self promptForFont: aPrompt andSendTo: aTarget withSelector: aSelector highlight: nil!

Item was added:
+ ----- Method: TextStyle class>>promptForFont:andSendTo:withSelector:highlight: (in category '*Morphic-user interface') -----
+ promptForFont: aPrompt andSendTo: aTarget withSelector: aSelector highlight: currentFont
+ "Morphic Only!! prompt for a font and if one is provided, send it to aTarget using a
+ message with selector aSelector."
+ "TextStyle promptForFont: 'Choose system font:' andSendTo: Preferences withSelector:
+ #setSystemFontTo: "
+ "Derived from a method written by Robin Gibson"
+ | menu currentTextStyle |
+ currentTextStyle := currentFont
+ ifNotNil: [currentFont textStyleName].
+ menu := MenuMorph entitled: aPrompt.
+ self actualTextStyles keysSortedSafely
+ do: [:styleName | | subMenu |
+ subMenu := self
+ fontMenuForStyle: styleName
+ target: aTarget
+ selector: aSelector
+ highlight: currentFont.
+ menu add: styleName subMenu: subMenu.
+ menu lastItem
+ font: ((self named: styleName)
+ fontOfSize: 18).
+ styleName = currentTextStyle
+ ifTrue: [menu lastItem color: Color blue darker]].
+ menu popUpInWorld: self currentWorld!