The Trunk: Graphics-fbs.220.mcz

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

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

Name: Graphics-fbs.220
Author: fbs
Time: 23 July 2013, 8:18:46.726 pm
UUID: 4066227b-0cc5-0f4f-a6b8-dd4f0c5e27f1
Ancestors: Graphics-fbs.219

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

=============== Diff against Graphics-fbs.219 ===============

Item was changed:
  SystemOrganization addCategory: #'Graphics-Display Objects'!
  SystemOrganization addCategory: #'Graphics-External-Ffenestri'!
  SystemOrganization addCategory: #'Graphics-Files'!
  SystemOrganization addCategory: #'Graphics-Fonts'!
  SystemOrganization addCategory: #'Graphics-Primitives'!
  SystemOrganization addCategory: #'Graphics-Text'!
  SystemOrganization addCategory: #'Graphics-Transformations'!
+ SystemOrganization addCategory: #'Graphics-Text Support'!

Item was removed:
- ----- Method: CompositionScanner>>composeFrom:inRectangle:firstLine:leftSide:rightSide: (in category 'scanning') -----
- 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 removed:
- ----- Method: DisplayScreen>>defaultCanvasClass (in category 'blitter defaults') -----
- defaultCanvasClass
- "Return the WarpBlt version to use when I am active"
- ^FormCanvas!

Item was removed:
- ----- Method: DisplayText>>composeForm (in category 'private') -----
- 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 added:
+ 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: 'Graphics-Text Support'!

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

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ Object subclass: #TextLine
+ instanceVariableNames: 'left right top bottom firstIndex lastIndex internalSpaces paddingWidth baseline leftMargin'
+ classVariableNames: ''
+ poolDictionaries: 'TextConstants'
+ category: 'Graphics-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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: TextLine>>baseline (in category 'accessing') -----
+ baseline
+ ^ baseline!

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

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

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

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

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

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

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

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

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: TextLine>>last (in category 'accessing') -----
+ last
+ ^ lastIndex!

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

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

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

Item was added:
+ ----- 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 added:
+ ----- Method: TextLine>>lineHeight (in category 'accessing') -----
+ lineHeight
+ ^ bottom - top!

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

Item was added:
+ ----- 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 added:
+ ----- Method: TextLine>>paddingWidth (in category 'accessing') -----
+ paddingWidth
+ "Answer the amount of space to be added to the font."
+
+ ^paddingWidth!

Item was added:
+ ----- 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 added:
+ ----- Method: TextLine>>printOn: (in category 'printing') -----
+ printOn: aStream
+ super printOn: aStream.
+ aStream space; print: firstIndex; nextPutAll: ' to: '; print: lastIndex!

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

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

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

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

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

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: TextLine>>top (in category 'accessing') -----
+ top
+ ^ top!

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

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

Item was removed:
- ----- Method: TextStyle class>>emphasisMenuForFont:target:selector:highlight: (in category '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 removed:
- ----- Method: TextStyle class>>fontMenuForStyle:target:selector: (in category 'user interface') -----
- fontMenuForStyle: styleName target: target selector: selector
- ^self fontMenuForStyle: styleName target: target selector: selector highlight: nil!

Item was removed:
- ----- Method: TextStyle class>>fontMenuForStyle:target:selector:highlight: (in category '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 removed:
- ----- Method: TextStyle class>>fontSizeSummary (in category '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 removed:
- ----- Method: TextStyle class>>promptForFont:andSendTo:withSelector: (in category 'user interface') -----
- promptForFont: aPrompt andSendTo: aTarget withSelector: aSelector
- self promptForFont: aPrompt andSendTo: aTarget withSelector: aSelector highlight: nil!

Item was removed:
- ----- Method: TextStyle class>>promptForFont:andSendTo:withSelector:highlight: (in category '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!