'From Cuis 2.6 of 10 August 2010 [latest update: #540] on 27 August 2010 at 11:40:12 am'!
!classDefinition: #NewParagraph category: #'System-Text'!
Object subclass: #NewParagraph
	instanceVariableNames: 'text container lines positionWhenComposed maxRightX selectionStart selectionStop focused editor caretRect showCaret '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Text'!
!classDefinition: #TextMorph category: #'Morphic-Text Support'!
BorderedMorph subclass: #TextMorph
	instanceVariableNames: 'text wrapFlag paragraph editor backgroundColor pauseBlinking '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Text Support'!

!NewParagraph methodsFor: 'access' stamp: 'jmv 8/26/2010 11:19'!
caretRect
	^caretRect! !

!NewParagraph methodsFor: 'access' stamp: 'jmv 8/26/2010 12:00'!
focused
	^ focused! !

!NewParagraph methodsFor: 'access' stamp: 'jmv 8/26/2010 12:01'!
focused: aBoolean
	focused _ aBoolean! !

!NewParagraph methodsFor: 'access' stamp: 'jmv 8/26/2010 12:00'!
showCaret
	^showCaret! !

!NewParagraph methodsFor: 'access' stamp: 'jmv 8/26/2010 10:39'!
showCaret: aBool
	showCaret _ aBool! !

!NewParagraph methodsFor: 'display' stamp: 'jmv 8/26/2010 12:14'!
displayClassicInsertionMarkAtX: x top: top bottom: bottom emphasis: emphasis on: aCanvas
	| caretColor e x1 x2 isBold isItalic x0 xtraWidth |
	isBold _ emphasis allMask: 1.
	isItalic _ emphasis allMask: 2.
	caretColor _ self insertionPointColor.
	xtraWidth _ isBold ifTrue: [ 1 ] ifFalse: [ 0 ].
	isItalic ifTrue: [
		x0 _ x - 2.
		x1 _ x0 - 2.
		x2 _ x0 - 6 ]
	ifFalse: [
		x0 _ x.
		x1 _ x0 - 4.
		x2 _ x1 ].
	1 to: 2 do: [ :i | 
		"Draw caret triangles at top and bottom"
		e _ (2 - i) * 2 + 4+xtraWidth @ 1.
		aCanvas fillRectangle: (x1 + i @ (top + i - 1) extent: e)
			color: caretColor.
		aCanvas fillRectangle: (x2 + i @ (bottom - i) extent: e)
			color: caretColor].
	aCanvas fillRectangle: (x0-1 @ top corner: x0+1+xtraWidth @ bottom)
		color: caretColor! !

!NewParagraph methodsFor: 'display' stamp: 'jmv 8/26/2010 12:15'!
displayInsertionMarkAtX: x top: top bottom: bottom emphasis: emphasis on: aCanvas
	self displayThinInsertionMarkAtX: x top: top bottom: bottom emphasis: emphasis on: aCanvas! !

!NewParagraph methodsFor: 'display' stamp: 'jmv 8/26/2010 14:03'!
displaySelectionInLine: line on: aCanvas
	| leftX rightX idx caretFont t b caretAttributes |
	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"
	selectionStart = selectionStop 
		ifTrue: [
			leftX _ selectionStart left.
			idx _ selectionStart stringIndex.
			caretAttributes _ editor ifNotNil: [ editor currentAttributes ].
			caretFont _ caretAttributes
				ifNil: [ text fontAt: idx ]
				ifNotNil: [ text fontIfApplying: caretAttributes ].
			b _ line top + line baseline + caretFont descent.
			t _ line top + line baseline - caretFont ascent.
			self showCaret ifTrue: [
				self
					displayInsertionMarkAtX: leftX
					top: t
					bottom: b
					emphasis: caretFont emphasis
					on: aCanvas ]]
		ifFalse: [
			caretRect _ nil.
			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].
			aCanvas fillRectangle: (leftX @ line top corner: rightX @ line bottom)
				color: self selectionColor]! !

!NewParagraph methodsFor: 'display' stamp: 'jmv 8/26/2010 14:08'!
displayThinInsertionMarkAtX: x top: top bottom: bottom emphasis: emphasis on: aCanvas
	| caretColor x1 isBold isItalic x0 h w halfW |
	isBold _ emphasis allMask: 1.
	isItalic _ emphasis allMask: 2.
	caretColor _ self insertionPointColor.
	h _ bottom - top.
	w _ isBold
		ifTrue: [ h // 25 + 2 ]
		ifFalse: [ h // 30 + 1 ].
	halfW _ w // 2.
	isItalic
		ifTrue: [	
			x0 _ x - (h * 1 // 22) - 3.
			x1 _ x + (h * 4 // 22 ) - 3.
			isBold ifTrue: [
				x0 _ x0 - 3.
				x1 _ x1 - 3 ]]
		ifFalse: [
			x0 _ x.
			x1 _ x].
	x0 < halfW ifTrue: [
		x1 _ x1 - x0 + halfW.
		x0 _ halfW ].
	caretRect _ x0-halfW@ top corner: x1+halfW+1 @ bottom.
	aCanvas
		line: x0@(bottom-halfW) to: x1@(top+halfW)
		width: w color: caretColor! !

!NewParagraph methodsFor: 'display' stamp: 'jmv 8/26/2010 11:48'!
insertionPointColor
	^ Display depth <= 2
		ifTrue: [Color black]
		ifFalse: [Preferences insertionPointColor]! !

!NewParagraph methodsFor: 'initialization' stamp: 'jmv 8/26/2010 12:00'!
initialize
	focused _ false.
	showCaret _ false.! !


!Preferences class methodsFor: 'text highlighting' stamp: 'jmv 8/26/2010 12:09'!
initializeTextHighlightingParameters
	"
	Preferences initializeTextHighlightingParameters
	"
	Parameters at: #insertionPointColor put:
		"(Color r: 0.4 g: 1.0 b: 0)"
		"(Color r: 0.9 g: 0.2 b: 0)"
		Color black.
	Parameters at: #textHighlightColor put: (Color r: 0.4 g: 1.0 b: 0).! !


!TextMorph methodsFor: 'event handling' stamp: 'jmv 8/26/2010 11:43'!
keyStroke: evt
	"Handle a keystroke event."
	| action |
	(evt commandKeyPressed and: [ self focusKeyboardFor: evt ])
		ifTrue: [ ^ self ].
	self pauseBlinking.
	evt keyValue = 13 ifTrue:["CR - check for special action"
		action _ self crAction.
		action ifNotNil:[
			"Note: Code below assumes that this was some
			input field reacting on CR. Break the keyboard
			focus so that the receiver can be safely deleted."
			evt hand newKeyboardFocus: nil.
			^action value]].
	self handleInteraction: [ editor processKeyStroke: evt ].
	self updateFromParagraph.
	super keyStroke: evt  "sends to keyStroke event handler, if any"! !

!TextMorph methodsFor: 'event handling' stamp: 'jmv 8/26/2010 10:59'!
keyboardFocusChange: aBoolean
	
	paragraph ifNotNil: [ paragraph focused: aBoolean ].
	aBoolean
		ifTrue: [
			"A hand is wanting to send us characters..."
			editor ifNil: [ self editor ].	"Forces install"
			self startBlinking ]
		ifFalse: [ self stopBlinking ].
	self changed! !

!TextMorph methodsFor: 'blinking cursor' stamp: 'jmv 8/26/2010 11:36'!
onBlinkCursor
	"Blink the cursor"
	paragraph ifNil: [ ^nil ].
	paragraph showCaret: paragraph showCaret not | pauseBlinking.
	pauseBlinking _ false.
	paragraph caretRect ifNotNil: [ :r | self invalidRect: r].! !

!TextMorph methodsFor: 'blinking cursor' stamp: 'jmv 8/26/2010 11:56'!
pauseBlinking
	"Reset the blinking cursor"
	pauseBlinking _ true.
	paragraph ifNotNil: [
		"Show cursor right now if needed"
		paragraph showCaret ifFalse: [
			paragraph showCaret: true.
			paragraph caretRect ifNotNil: [ :r | self invalidRect: r ]]]! !

!TextMorph methodsFor: 'blinking cursor' stamp: 'jmv 8/26/2010 11:56'!
startBlinking
	pauseBlinking _ true.
	"Start blinking in a short while"
	paragraph ifNotNil: [ paragraph showCaret: true ].
	self
		startStepping: #onBlinkCursor
		at: Time millisecondClockValue
		arguments: nil
		stepTime: 500.! !

!TextMorph methodsFor: 'blinking cursor' stamp: 'jmv 8/26/2010 11:51'!
stopBlinking
	self stopSteppingSelector: #onBlinkCursor.
	paragraph ifNotNil: [
		"Show cursor right now if needed"
		paragraph showCaret ifTrue: [
			paragraph showCaret: false.
			paragraph caretRect ifNotNil: [ :r | self invalidRect: r ]]]! !

!classDefinition: #TextMorph category: #'Morphic-Text Support'!
BorderedMorph subclass: #TextMorph
	instanceVariableNames: 'text wrapFlag paragraph editor backgroundColor pauseBlinking'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Text Support'!
!classDefinition: #NewParagraph category: #'System-Text'!
Object subclass: #NewParagraph
	instanceVariableNames: 'text container lines positionWhenComposed maxRightX selectionStart selectionStop focused editor showCaret caretRect'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Text'!
"Postscript:
Leave the line above, and replace the rest of this comment by a useful one.
Executable statements should follow this comment, and should
be separated by periods, with no exclamation points (!!).
Be sure to put any further comments in double-quotes, like this one."
	Preferences initializeTextHighlightingParameters.
	NewParagraph allInstances do: [ :a | a initialize ]!

