'From Cuis 1.0 of 6 August 2009 [latest update: #258] on 12 August 2009 at 9:25:11 pm'!
!classDefinition: #CharacterScanner category: #'Graphics-Text'!
Object subclass: #CharacterScanner
	instanceVariableNames: 'destX lastIndex xTable map destY stopConditions text initialTextStyle alignment leftMargin rightMargin font line runStopIndex spaceCount spaceWidth emphasisCode kern actualTextStyle '
	classVariableNames: 'DefaultStopConditions '
	poolDictionaries: ''
	category: 'Graphics-Text'!
!classDefinition: #NewParagraph category: #'System-Text'!
Object subclass: #NewParagraph
	instanceVariableNames: 'text textStyle container lines positionWhenComposed offsetToEnd maxRightX selectionStart selectionStop focused '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Text'!
!classDefinition: #Text category: #'System-Text'!
ArrayedCollection subclass: #Text
	instanceVariableNames: 'string runs initialStyle '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Text'!
!classDefinition: #TextComposer category: #'Morphic-Text Support'!
Object subclass: #TextComposer
	instanceVariableNames: 'lines maxRightX currentY scanner possibleSlide nowSliding prevIndex prevLines currCharIndex startCharIndex stopCharIndex deltaCharIndex theText theContainer isFirstLine theTextStyle defaultLineHeight actualHeight '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Text Support'!
!classDefinition: #TextMorph category: #'Morphic-Text Support'!
RectangleMorph subclass: #TextMorph
	instanceVariableNames: 'textStyle text wrapFlag paragraph editor container backgroundColor margins '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Text Support'!

!AbstractFont methodsFor: 'measuring' stamp: 'jmv 8/12/2009 21:21'!
widthOfString: aString
	aString ifNil:[^0].
	^self widthOfString: aString from: 1 to: aString size.
"
	AbstractFont default widthOfString: 'zort' 
"! !


!CharacterScanner methodsFor: 'private' stamp: 'jmv 8/12/2009 20:53'!
setFont
	| priorFont |
	"Set the font and other emphasis.
	In fact set actual TextStyle, alignment, font and emphasis"
	priorFont _ font.
	text ifNotNil: [
		font _ nil.
		emphasisCode _ 0.
		kern _ 0.
		actualTextStyle _ text initialStyle.
		alignment _ actualTextStyle alignment.
		(text attributesAt: lastIndex)
			do: [:att | att emphasizeScanner: self]].
	font ifNil: [
		self setActualFont: actualTextStyle font].
	font _ font emphasized: emphasisCode.
	priorFont ifNotNil: [ destX _ destX + priorFont descentKern ].
	destX _ destX - font descentKern.
	"NOTE: next statement should be removed when clipping works"
	leftMargin ifNotNil: [destX _ destX max: leftMargin].
	kern _ kern - font baseKern.

	"Install various parameters from the font."
	spaceWidth _ font widthOf: Character space.
	xTable _ font xTable.
	map _ font characterToGlyphMap.
	stopConditions _ DefaultStopConditions.! !

!CharacterScanner methodsFor: 'private' stamp: 'jmv 8/12/2009 20:55'!
text: aText
	text _ aText.
	actualTextStyle _ text initialStyle! !


!CompositionScanner methodsFor: 'stop conditions' stamp: 'jmv 8/12/2009 21:04'!
crossedX
	"There is a word that has fallen across the right edge of the composition 
	rectangle. This signals the need for wrapping which is done to the last 
	space that was encountered, as recorded by the space stop condition."

	spaceCount >= 1 ifTrue: [
		"The common case. First back off to the space at which we wrap."
		line stop: spaceIndex.
		lineHeight _ lineHeightAtSpace.
		baseline _ baselineAtSpace.
		spaceCount _ spaceCount - 1.
		spaceIndex _ spaceIndex - 1.

		"Check to see if any spaces preceding the one at which we wrap.
			Double space after punctuation, most likely."
		[(spaceCount > 1 and: [(text at: spaceIndex) = Character space])]
			whileTrue: [
				spaceCount _ spaceCount - 1.
				"Account for backing over a run which might
					change width of space."
				font _ text fontAt: spaceIndex.
				spaceIndex _ spaceIndex - 1.
				spaceX _ spaceX - (font widthOf: Character space)].
		line paddingWidth: rightMargin - spaceX.
		line internalSpaces: spaceCount]
	ifFalse: [
		"Neither internal nor trailing spaces -- almost never happens."
		lastIndex _ lastIndex - 1.
		[destX <= rightMargin]
			whileFalse: [
				destX _ destX - (font widthOf: (text at: lastIndex)).
				lastIndex _ lastIndex - 1].
		spaceX _ destX.
		line paddingWidth: rightMargin - destX.
		line stop: (lastIndex max: line first)].
	^true! !


!DisplayScanner methodsFor: 'private' stamp: 'jmv 8/12/2009 20:53'!
text: t textStyle: ts foreground: foreColor background: backColor fillBlt: blt ignoreColorChanges: shadowMode
	text _ t.
	actualTextStyle _ ts.
	foregroundColor _ paragraphColor _ foreColor.
	(backgroundColor _ backColor) isTransparent ifFalse: [
		fillBlt _ blt.
		fillBlt fillColor: backgroundColor].
	ignoreColorChanges _ shadowMode! !


!EntryField2LW methodsFor: 'drawing' stamp: 'jmv 8/12/2009 20:55'!
characterIndexAtPoint: aPoint

	| line block |
	
	line _ TextLine 
		start: 1
		stop: contents size
		internalSpaces: 0
		paddingWidth: 0.
	line
		rectangle: bounds;
		lineHeight: font height baseline: font ascent.
		
	block _ (CharacterBlockScanner new text: 
			(contents asText initialStyle: font defaultTextStyle))
		characterBlockAtPoint: aPoint index: nil
		in: line.

	^ block stringIndex! !


!GrafPort methodsFor: 'accessing' stamp: 'jmv 8/12/2009 20:49'!
displayScannerFor: para foreground: foreColor background: backColor ignoreColorChanges: shadowMode

	^ (DisplayScanner new text: para text textStyle: para text initialStyle
			foreground: foreColor background: backColor fillBlt: self
			ignoreColorChanges: shadowMode)
		setPort: self clone
! !


!NewParagraph methodsFor: 'composition' stamp: 'jmv 8/12/2009 20:51'!
compose: t in: textContainer
	text _ t.
	offsetToEnd _ text size - 1.
	container _ textContainer.
	self composeAll! !

!NewParagraph methodsFor: 'composition' stamp: 'jmv 8/12/2009 20:58'!
composeLinesFrom: start to: stop delta: delta into: lineColl priorLines: priorLines atY: startingY 
	"While the section from start to stop has changed, composition may ripple all the way to the end of the text.  However in a rectangular container, if we ever find a line beginning with the same character as before (ie corresponding to delta in the old lines), then we can just copy the old lines from there to the end of the container, with adjusted indices and y-values"

	| newResult |
	newResult := TextComposer new 
				composeLinesFrom: start
				to: stop
				delta: delta
				into: lineColl
				priorLines: priorLines
				atY: startingY
				text: text
				container: container.
	lines := newResult first asArray.
	maxRightX := newResult second.
	^maxRightX! !

!NewParagraph methodsFor: 'copying' stamp: 'jmv 8/12/2009 20:44'!
deepCopy
	"Don't want to copy the container (etc) or fonts in the TextStyle."
	"jmv note We don't copy TextStyles anymore. We want to preserve their identity."
	| new |
	new _ self copy.
	new
		lines: lines copy
		text: text deepCopy.
	^ new! !

!NewParagraph methodsFor: 'display' stamp: 'jmv 8/12/2009 21:04'!
displaySelectionInLine: line on: aCanvas 
	| leftX rightX idx caretFont t b caretEmphasis |
	selectionStart ifNil: [^self].	"No selection"
	selectionStart = selectionStop 
		ifTrue: [
			"Only show caret on line where clicked"
			selectionStart textLine ~= line ifTrue: [^self]]
		ifFalse: [
			"Test entire selection before or after here"
			(selectionStop stringIndex < line first 
				or: [selectionStart stringIndex > (line last + 1)]) ifTrue: [^self].	"No selection on this line"
			(selectionStop stringIndex = line first 
				and: [selectionStop textLine ~= line]) ifTrue: [^self].	"Selection ends on line above"
			(selectionStart stringIndex = (line last + 1) 
				and: [selectionStop textLine ~= line]) ifTrue: [^self]].	"Selection begins on line below"
	leftX := (selectionStart stringIndex < line first 
				ifTrue: [line ]
				ifFalse: [selectionStart ]) left.
	rightX := (selectionStop stringIndex > (line last + 1) or: [
					selectionStop stringIndex = (line last + 1) 
						and: [selectionStop textLine ~= line]]) 
				ifTrue: [line right]
				ifFalse: [selectionStop left].
	selectionStart = selectionStop 
		ifTrue: [
			idx _ selectionStart stringIndex.
			caretFont _ text fontAt: idx.
			caretEmphasis _ text emphasisAt: idx.
			b _ line top + line baseline + caretFont descent.
			t _ line top + line baseline - caretFont ascent.
			self
				displayInsertionMarkAtX: leftX
				top: t
				bottom: b
				width: self caretWidth
				emphasis: caretEmphasis
				on: aCanvas
			]
		ifFalse: [
			aCanvas fillRectangle: (leftX @ line top corner: rightX @ line bottom)
				color: self selectionColor]! !

!NewParagraph methodsFor: 'selection' stamp: 'jmv 8/12/2009 20:56'!
characterBlockAtPoint: aPoint 
	"Answer a CharacterBlock for the character in the text at aPoint."
	| line |
	line _ lines at: (self lineIndexForPoint: aPoint).
	^ (CharacterBlockScanner new text: text)
		characterBlockAtPoint: aPoint index: nil
		in: line! !

!NewParagraph methodsFor: 'selection' stamp: 'jmv 8/12/2009 20:56'!
characterBlockForIndex: index 
	"Answer a CharacterBlock for the character in text at index."
	| line |
	line _ lines at: (self lineIndexForCharacter: index).
	^ (CharacterBlockScanner new text: text)
		characterBlockAtPoint: nil index: ((index max: line first) min: text size+1)
		in: line! !

!NewParagraph methodsFor: 'private' stamp: 'jmv 8/12/2009 20:44'!
lines: l text: t
	"Private -- just a service for deepCopy"
	lines _ l.
	text _ t.! !


!OneLineEditorMorph methodsFor: 'drawing' stamp: 'jmv 8/12/2009 20:56'!
characterIndexAtPoint: aPoint

	| line block f |
	f _ self fontToUse.
	
	line _ TextLine 
		start: 1
		stop: contents size
		internalSpaces: 0
		paddingWidth: 0.
	line
		rectangle: bounds;
		lineHeight: f height baseline: f ascent.
		
	block _ (CharacterBlockScanner new text: 
			(contents asText initialStyle: font defaultTextStyle))
		characterBlockAtPoint: aPoint index: nil
		in: line.

	^ block stringIndex! !


!PluggableTextMorph methodsFor: 'initialization' stamp: 'jmv 8/12/2009 21:20'!
font: aFont
	"This only works if there are no TextFontReference or TextStyleReference in the text"
	textMorph setTextStyle: aFont defaultTextStyle! !


!Text methodsFor: 'accessing' stamp: 'jmv 8/12/2009 19:32'!
initialStyle
	initialStyle ifNil: [ initialStyle _ TextStyle default ].
	^initialStyle! !

!Text methodsFor: 'accessing' stamp: 'jmv 8/12/2009 18:52'!
initialStyle: aTextStyle
	initialStyle _ aTextStyle! !

!Text methodsFor: 'emphasis' stamp: 'jmv 8/12/2009 21:03'!
fontAt: characterIndex
	"Answer the font for characters in the run beginning at characterIndex."
	| attributes font |
	self size = 0 ifTrue: [^ initialStyle font].	"null text tolerates access"
	attributes _ runs at: characterIndex.
	font _ initialStyle font.  "default"
	attributes do: [:att | 
		att forFontDo: [ :f | font _ f ]].
	^ font! !


!Text class methodsFor: 'private' stamp: 'jmv 8/12/2009 19:02'!
string: aString runs: anArray
 
	^self basicNew 
		initialStyle: TextStyle default;
		setString: aString setRuns: anArray! !


!TextAttribute methodsFor: 'as yet unclassified' stamp: 'jmv 8/11/2009 10:06'!
forFontDo: aBlock
	"No action is the default.  Overridden by font specs"! !


!TextComposer methodsFor: 'as yet unclassified' stamp: 'jmv 8/12/2009 21:04'!
addNullLineWithIndex: index andRectangle: r
	
	| f |
	f _ theText fontAt: theText size + 1.
	lines addLast: (
		(
			TextLine 
				start: index 
				stop: index - 1
				internalSpaces: 0 
				paddingWidth: 0
		)
			rectangle: r;
			lineHeight: f height baseline: f ascent
	)
! !

!TextComposer methodsFor: 'as yet unclassified' stamp: 'jmv 8/12/2009 21:10'!
composeLinesFrom: argStart to: argStop delta: argDelta into: argLinesCollection priorLines: argPriorLines atY: argStartY text: argText container: argContainer

	lines _ argLinesCollection.
	theText _ argText.
	theContainer _ argContainer.
	deltaCharIndex _ argDelta.
	currCharIndex _ startCharIndex _ argStart.
	stopCharIndex _ argStop.
	prevLines _ argPriorLines.
	currentY _ argStartY.
	defaultLineHeight _ theText initialStyle initialLineGrid.
	maxRightX _ theContainer left.
	possibleSlide _ stopCharIndex < theText size and: [theContainer isMemberOf: Rectangle].
	nowSliding _ false.
	prevIndex _ 1.
	scanner _ CompositionScanner new text: theText.
	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}

! !


!TextEditor methodsFor: 'attributes' stamp: 'jmv 8/12/2009 20:49'!
changeEmphasisOrAlignment
	| aList reply  code align menuList startIndex |
	startIndex _ self startIndex.
	aList _ #(normal bold italic narrow underlined struckOut leftFlush centered rightFlush justified).	
	align _ paragraph text alignmentAt: startIndex 
		ifAbsent: [ paragraph text initialStyle alignment ].
	code _ paragraph text emphasisAt: startIndex.
	menuList _ WriteStream on: Array new.
	menuList nextPut: (code isZero ifTrue:['<on>'] ifFalse:['<off>']), 'normal' translated.
	menuList nextPutAll: (#(bold italic underlined struckOut) collect:[:emph|
		(code anyMask: (TextEmphasis perform: emph) emphasisCode)
			ifTrue: [ '<on>', emph asString translated ]
			ifFalse: [ '<off>',emph asString translated ]]).
	((paragraph text attributesAt: startIndex)
		anySatisfy: [ :attr | attr isKern and: [attr kern < 0 ]]) 
			ifTrue: [ menuList nextPut:'<on>', 'narrow' translated ]
			ifFalse: [ menuList nextPut:'<off>', 'narrow' translated ].
	menuList nextPutAll: (#(leftFlush centered rightFlush justified) collectWithIndex: [ :type :i |
		align = (i-1)
			ifTrue: [ '<on>',type asString translated ]
			ifFalse: [ '<off>',type asString translated ]]).
	aList _ #(normal bold italic underlined struckOut narrow leftFlush centered rightFlush justified).
	reply _ (SelectionMenu labelList: menuList contents lines: #(1 6) selections: aList) startUpWithoutKeyboard.
	reply notNil ifTrue: [
		(#(leftFlush centered rightFlush justified) includes: reply)
			ifTrue: [
				self setAlignment: reply.
				paragraph composeAll.
				self recomputeInterval]
			ifFalse: [
				self setEmphasis: reply.
				paragraph composeAll.
				self recomputeSelection]].
	^ true! !

!TextEditor methodsFor: 'attributes' stamp: 'jmv 8/12/2009 20:51'!
changeStyle
	"Let user change styles for the current text pane."
	| names reply style current menuList |

	current _ paragraph text initialStyle.
	names _ TextStyle availableTextStyleNames.
	menuList _ names collect: [ :styleName |
		styleName = current name
			ifTrue: [ '<on>', styleName ]
			ifFalse: [ '<off>', styleName ]].
	reply _ (SelectionMenu labelList: menuList lines: #() selections: names) startUp.
	reply ifNotNil: [
		(style _ TextStyle named: reply) ifNil: [Beeper beep. ^ true].
		paragraph text initialStyle: style.
		paragraph composeAll.
		self recomputeSelection].
	^ true! !

!TextEditor methodsFor: 'attributes' stamp: 'jmv 8/12/2009 21:04'!
changeTextFont
	"Present a menu of available fonts, and if one is chosen, apply it to the current selection."
	| curFont newFont attr startIndex |
	startIndex _ self startIndex.
	curFont _ paragraph text fontAt: startIndex.
	newFont _ StrikeFont fromUser: curFont.
	newFont ifNil: [ ^self ].
	attr _ TextFontReference toFont: newFont.
	paragraph text addAttribute: attr from: startIndex to: (self stopIndex-1 min: paragraph text size).
	paragraph composeAll.
	self recomputeInterval.
	morph changed.! !


!TextFontReference methodsFor: 'as yet unclassified' stamp: 'jmv 8/11/2009 10:06'!
forFontDo: aBlock
	aBlock value: font! !


!TextMorph methodsFor: 'containment' stamp: 'jmv 8/12/2009 19:26'!
fillingOnOff
	"Establish a container for this text, with opposite filling status"
	self setContainer:
		(container
			ifNil: [TextContainer new for: self minWidth: text initialStyle initialLineGrid*2]
			ifNotNil: [(container fillsOwner and: [container avoidsOcclusions not])
				ifTrue: [nil  "Return to simple rectangular bounds"]
				ifFalse: [container fillsOwner: container fillsOwner not]])! !

!TextMorph methodsFor: 'containment' stamp: 'jmv 8/12/2009 19:25'!
occlusionsOnOff
	"Establish a container for this text, with opposite occlusion avoidance status"
	self setContainer:
		(container
			ifNil: [(TextContainer new for: self minWidth: text initialStyle initialLineGrid*2)
					fillsOwner: false; avoidsOcclusions: true]
			ifNotNil: [(container avoidsOcclusions and: [container fillsOwner not])
				ifTrue: [nil  "Return to simple rectangular bounds"]
				ifFalse: [container avoidsOcclusions: container avoidsOcclusions not]])! !

!TextMorph methodsFor: 'copying' stamp: 'jmv 8/12/2009 19:16'!
copy
	"jmv note We don't copy TextStyles anymore. We want to preserve their identity."
	^ super copy
		text: text copy
		wrap: wrapFlag 
		color: color! !

!TextMorph methodsFor: 'copying' stamp: 'jmv 8/12/2009 18:50'!
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.
	text _ text veryDeepCopyWith: deepCopier.
	wrapFlag _ wrapFlag veryDeepCopyWith: deepCopier.
	paragraph _ paragraph veryDeepCopyWith: deepCopier.
	editor _ editor veryDeepCopyWith: deepCopier.
	container _ container veryDeepCopyWith: deepCopier.
	backgroundColor _ backgroundColor veryDeepCopyWith: deepCopier.
	margins _ margins veryDeepCopyWith: deepCopier! !

!TextMorph methodsFor: 'geometry' stamp: 'jmv 8/12/2009 19:32'!
defaultLineHeight
	^ text initialStyle initialLineGrid! !

!TextMorph methodsFor: 'geometry' stamp: 'jmv 8/12/2009 19:26'!
minimumExtent
	| minExt |
	borderWidth ifNil: [^ 9@16].
	minExt _ (9@(text initialStyle initialLineGrid+2)) + (borderWidth*2).
	margins ifNil: [^ minExt].
	^ ((0@0 extent: minExt) expandBy: margins) extent! !

!TextMorph methodsFor: 'initialization' stamp: 'jmv 8/12/2009 19:28'!
initialize
	"jmv note: We don't copy TextStyles all over the place anymore. We want to preserve their identity."
	super initialize.
	borderWidth _ 0.
	wrapFlag _ true.
! !

!TextMorph methodsFor: 'initialization' stamp: 'jmv 8/12/2009 19:28'!
setTextStyle: aTextStyle

	text initialStyle: aTextStyle.
	self releaseCachedState; changed! !

!TextMorph methodsFor: 'private' stamp: 'jmv 8/12/2009 19:27'!
fit
	"Adjust my bounds to fit the text.  Should be a no-op if autoFit is not specified.
	Required after the text changes,
	or if wrapFlag is true and the user attempts to change the extent."

	| newExtent para cBounds lastOfLines heightOfLast |
	self isAutoFit 
		ifTrue: [
			newExtent := (self paragraph extent max: 9 @ text initialStyle initialLineGrid) + (0 @ 2).
			newExtent := newExtent + (2 * borderWidth).
			margins 
				ifNotNil: [newExtent := ((0 @ 0 extent: newExtent) expandBy: margins) extent].
			newExtent ~= bounds extent 
				ifTrue: [
					container isNil 
						ifTrue: 
							[para := paragraph.	"Save para (layoutChanged smashes it)"
							super extent: newExtent.
							paragraph := para]].
			container notNil
				ifTrue: [
					cBounds := container bounds truncated.
					"23 sept 2000 - try to allow vertical growth"
					lastOfLines := self paragraph lines last.
					heightOfLast := lastOfLines bottom - lastOfLines top.
					(lastOfLines last < text size 
						and: [lastOfLines bottom + heightOfLast >= self bottom]) 
							ifTrue: [
								container releaseCachedState.
								cBounds := cBounds origin corner: cBounds corner + (0 @ heightOfLast)].
					self privateBounds: cBounds]].

	"These statements should be pushed back into senders"
	self paragraph positionWhenComposed: self position.
	self changed	"Too conservative: only paragraph composition
					should cause invalidation."! !

!TextMorph methodsFor: 'private' stamp: 'jmv 8/12/2009 20:43'!
paragraph
	"Paragraph instantiation is lazy -- create it only when needed"
	paragraph ifNotNil: [^ paragraph].

	self setDefaultContentsIfNil.

	"...Code here to recreate the paragraph..."
	paragraph _ NewParagraph new.
	paragraph focused: self hasKeyboardFocus.
	paragraph
		compose: text
		in: self container.
	wrapFlag ifFalse: [
		"Was given huge container at first... now adjust"
		paragraph adjustRightX].
	self fit.

	^ paragraph! !

!TextMorph methodsFor: 'private' stamp: 'jmv 8/12/2009 19:15'!
text: t wrap: wrap color: c
	"Private -- for use only in morphic duplication"
	text _ t.
	wrapFlag _ wrap.
	color _ c.
	paragraph _ editor _ container _ nil! !

!TextMorph methodsFor: 'private' stamp: 'jmv 8/12/2009 20:50'!
updateFromParagraph
	"A change has taken place in my paragraph, as a result of editing and I must be updated.  If a line break causes recomposition of the current paragraph, or it the selection has entered a different paragraph, then the current editor will be released, and must be reinstalled with the resulting new paragraph, while retaining any editor state, such as selection, undo state, and current typing emphasis."
	"removed multiple lined paragraph support (predecessor and successor)"

	| newStyle sel oldEditor |
	paragraph ifNil: [ ^self ].
	wrapFlag ifNil: [ wrapFlag := true ].
	editor ifNotNil: [
		oldEditor := editor.
		sel := editor selectionInterval.
		editor storeSelectionInParagraph].
	text := paragraph text.
	paragraph text initialStyle = text initialStyle 
		ifTrue: [self fit]
		ifFalse: [
			newStyle := paragraph text initialStyle.
			text initialStyle: newStyle.
			self
				releaseParagraph;					"Force recomposition"
				fit.									"and propagate the change"
			editor ifNotNil: [self installEditorToReplace: editor]].
	super layoutChanged.
	sel ifNil: [^self].

	editor ifNil: [
		"Reinstate selection after, eg, style change"
		self installEditorToReplace: oldEditor]! !


!Transcripter methodsFor: 'initialization' stamp: 'jmv 8/12/2009 20:44'!
initInFrame: rect
	frame _ rect insetBy: 2.  "Leave room for border"
	para _ NewParagraph new.
	para
		compose: self contents asText
		in: ((frame insetBy: 4) withHeight: 9999)! !

!Transcripter methodsFor: 'accessing' stamp: 'jmv 8/12/2009 20:44'!
endEntry
	| c d cb |
	c _ self contents.
	Display extent ~= DisplayScreen actualScreenSize ifTrue: [
		"Handle case of user resizing physical window"
		DisplayScreen startUp.
		frame _ frame intersect: Display boundingBox.
		^ self clear; show: c].
	para compose: c asText
		in: ((frame insetBy: 4) withHeight: 9999).
	para positionWhenComposed: 0@0.
	d _ para extent y - frame height.
	d > 0 ifTrue: [
		"Scroll up to keep all contents visible"
		cb _ para characterBlockAtPoint:
			para compositionRectangle topLeft + (0@(d+TextStyle default initialLineGrid)).
		self on: (c copyFrom: cb stringIndex to: c size).
		readLimit_ position_ collection size.
		^ self endEntry].
	Display fill: (frame insetBy: -2) fillColor: self black;
			fill: frame fillColor: self white.
	Display getCanvas
		paragraph: para 
		bounds: (0@0 extent: Display extent) 
		color: Color black! !

TextMorph removeSelector: #paragraphClass!
TextMorph removeSelector: #text:textStyle:!
TextMorph removeSelector: #text:textStyle:wrap:color:!
!classDefinition: #TextMorph category: #'Morphic-Text Support'!
RectangleMorph subclass: #TextMorph
	instanceVariableNames: 'text wrapFlag paragraph editor container backgroundColor margins'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Text Support'!
TextFontReference removeSelector: #forFontInStyle:do:!
TextContainer removeSelector: #paragraphClass!
TextComposer removeSelector: #composeLinesFrom:to:delta:into:priorLines:atY:textStyle:text:container:!
!classDefinition: #TextComposer category: #'Morphic-Text Support'!
Object subclass: #TextComposer
	instanceVariableNames: 'lines maxRightX currentY scanner possibleSlide nowSliding prevIndex prevLines currCharIndex startCharIndex stopCharIndex deltaCharIndex theText theContainer isFirstLine defaultLineHeight actualHeight'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Text Support'!
TextAttribute removeSelector: #forFontInStyle:do:!
Text removeSelector: #fontAt:withStyle:!
!classDefinition: #Text category: #'System-Text'!
ArrayedCollection subclass: #Text
	instanceVariableNames: 'string runs initialStyle'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Text'!
NewParagraph removeSelector: #compose:style:in:!
NewParagraph removeSelector: #textOwner:!
NewParagraph removeSelector: #textStyle!
NewParagraph removeSelector: #textStyle:!
NewParagraph removeSelector: #textStyle:lines:text:!
!classDefinition: #NewParagraph category: #'System-Text'!
Object subclass: #NewParagraph
	instanceVariableNames: 'text container lines positionWhenComposed offsetToEnd maxRightX selectionStart selectionStop focused'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Text'!
CharacterScanner removeSelector: #text:textStyle:!
!classDefinition: #CharacterScanner category: #'Graphics-Text'!
Object subclass: #CharacterScanner
	instanceVariableNames: 'destX lastIndex xTable map destY stopConditions text alignment leftMargin rightMargin font line runStopIndex spaceCount spaceWidth emphasisCode kern actualTextStyle'
	classVariableNames: 'DefaultStopConditions'
	poolDictionaries: ''
	category: 'Graphics-Text'!
Smalltalk removeClassNamed: #AttributedTextStream!
