'From Cuis 1.0 of 28 July 2009 [latest update: #242] on 30 July 2009 at 12:01:13 pm'!
!classDefinition: #AbstractFont category: #'Graphics-Text'!
Object subclass: #AbstractFont
	instanceVariableNames: 'defaultTextStyle '
	classVariableNames: 'AvailableFonts DefaultFont '
	poolDictionaries: ''
	category: 'Graphics-Text'!
!classDefinition: #CharacterScanner category: #'Graphics-Text'!
Object subclass: #CharacterScanner
	instanceVariableNames: 'destX lastIndex xTable map destY stopConditions text textStyle alignment leftMargin rightMargin font line runStopIndex spaceCount spaceWidth emphasisCode kern indentationLevel initialTextStyle actualTextStyle '
	classVariableNames: 'DefaultStopConditions '
	poolDictionaries: ''
	category: 'Graphics-Text'!
!classDefinition: #CharacterBlockScanner category: #'Graphics-Text'!
CharacterScanner subclass: #CharacterBlockScanner
	instanceVariableNames: 'characterPoint characterIndex lastCharacter lastCharacterExtent lastSpaceOrTabExtent nextLeftMargin specialWidth '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Text'!

!TextAlignment commentStamp: 'jmv 7/29/2009 17:24' prior: 0!
Warning: TextAlignment and TextStyleReference should always be applied to whole 'paragraphs' in the text. For examples on how to do this, see senders of #encompassLine:.

(
(Text string: 'This text has no tyle set', String cr),
(Text string: 'This is centered', String cr attribute: TextAlignment centered),
(Text string: 'This text has no tyle set', String cr)
) edit!


!TextFontReference commentStamp: '<historical>' prior: 0!
A TextFontReference encodes a font change applicable over a given range of text.!

!classDefinition: #TextLine category: #'Morphic-Text Support'!
Object subclass: #TextLine
	instanceVariableNames: 'left right top bottom firstIndex lastIndex internalSpaces paddingWidth baseline leftMargin '
	classVariableNames: ''
	poolDictionaries: ''
	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
TextLine's rather verbose message protocol is required for compatibility with the old CharacterScanners.!

!classDefinition: #TextStyle category: #'Graphics-Text'!
Object subclass: #TextStyle
	instanceVariableNames: 'name font lineGrid baseline alignment firstIndent restIndent rightIndent tabsArray marginTabsArray leading '
	classVariableNames: 'AvailableTextStyles DefaultTextStyle '
	poolDictionaries: ''
	category: 'Graphics-Text'!

!TextStyle commentStamp: '<historical>' prior: 0!
A TextStyle comprises the formatting information for composing and displaying a unit (usually a paragraph) of text.  Typically one makes a copy of a master TextStyle (such as TextStyle default), and then that copy may get altered in the process of editing.  Bad things can happen if you do not copy first.

Each of my instances consists of...
	font				The default font to use
	alignment			An integer; text alignment, see TextStyle alignment:
	tabsArray			An array of integers giving tab offsets in pixels

For a concrete example, look at TextStyle default copy inspect!


!AbstractFont methodsFor: 'accessing' stamp: 'jmv 7/30/2009 00:47'!
defaultTextStyle

	defaultTextStyle ifNil: [ defaultTextStyle _ TextStyle withFont: self ].
	^defaultTextStyle! !


!CharacterScanner methodsFor: 'private' stamp: 'jmv 7/29/2009 17:26'!
setActualTextStyle: aTextStyle

	actualTextStyle _ aTextStyle.
	self setActualFont: aTextStyle font.
	self setAlignment: aTextStyle alignment! !

!CharacterScanner methodsFor: 'private' stamp: 'jmv 7/29/2009 17:15'!
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.
		alignment _ initialTextStyle alignment.
		actualTextStyle _ initialTextStyle.
		(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 7/29/2009 16:59'!
text: aText textStyle: aTextStyle
	text _ aText.
	initialTextStyle _ aTextStyle.
	actualTextStyle _ aTextStyle! !

!CharacterScanner methodsFor: 'scanning' stamp: 'ar 12/31/2001 00:52'!
measureString: aString inFont: aFont from: startIndex to: stopIndex
	"WARNING: In order to use this method the receiver has to be set up using #initializeStringMeasurer"
	destX _ destY _ lastIndex _ 0.
	xTable _ aFont xTable.
	map _ aFont characterToGlyphMap.
	self scanCharactersFrom: startIndex to: stopIndex in: aString rightX: 999999 stopConditions: stopConditions kern: 0.
	^destX! !

!CharacterScanner methodsFor: 'scanning' stamp: 'jmv 7/29/2009 16:57'!
plainTab
	"This is the basic method of adjusting destX for a tab."
	destX _ (alignment = CharacterScanner justifiedCode and: [self leadingTab not])
		ifTrue:	[	"embedded tabs in justified text are weird"
			destX + (actualTextStyle tabWidth - (line justifiedTabDeltaFor: spaceCount)) max: destX]
		ifFalse: [ 
			actualTextStyle nextTabXFrom: destX
				leftMargin: leftMargin
				rightMargin: rightMargin]! !


!CharacterBlockScanner methodsFor: 'stop conditions' stamp: 'jmv 7/28/2009 18:27'!
cr 
	"Answer a CharacterBlock that specifies the current location of the mouse 
	relative to a carriage return stop condition that has just been 
	encountered. The ParagraphEditor convention is to denote selections by 
	CharacterBlocks, sometimes including the carriage return (cursor is at 
	the end) and sometimes not (cursor is in the middle of the text)."

	((characterIndex ~= nil
		and: [characterIndex > text size])
			or: [(line last = text size)
				and: [(destY + line lineHeight) < characterPoint y]])
		ifTrue:	["When off end of string, give data for next character"
				destY _ destY +  line lineHeight.
				lastCharacter _ nil.
				characterPoint _ leftMargin @ destY.
				lastIndex _ lastIndex + 1.
				self lastCharacterExtentSetX: 0.
				^ true].
		lastCharacter _ Character cr.
		characterPoint _ destX @ destY.
		self lastCharacterExtentSetX: rightMargin - destX.
		^true! !

!CharacterBlockScanner methodsFor: 'stop conditions' stamp: 'jmv 7/29/2009 16:58'!
crossedX
	"Text display has wrapping. The scanner just found a character past the x 
	location of the cursor. We know that the cursor is pointing at a character 
	or before one."

	| leadingTab currentX |
	characterIndex == nil ifFalse: [
		"If the last character of the last line is a space,
		and it crosses the right margin, then locating
		the character block after it is impossible without this hack."
		characterIndex > text size ifTrue: [
			lastIndex _ characterIndex.
			characterPoint _ leftMargin @ (destY + line lineHeight).
			^true]].
	characterPoint x <= (destX + (lastCharacterExtent x // 2))
		ifTrue:	[lastCharacter _ (text at: lastIndex).
				characterPoint _ destX @ destY.
				^true].
	lastIndex >= line last 
		ifTrue:	[lastCharacter _ (text at: line last).
				characterPoint _ destX @ destY.
				^true].

	"Pointing past middle of a character, return the next character."
	lastIndex _ lastIndex + 1.
	lastCharacter _ text at: lastIndex.
	currentX _ destX + lastCharacterExtent x + kern.
	self lastCharacterExtentSetX: (font widthOf: lastCharacter).
	characterPoint _ currentX @ destY.
	lastCharacter = Character space ifFalse: [^ true].

	"Yukky if next character is space or tab."
	alignment = CharacterScanner justifiedCode ifTrue:
		[self lastCharacterExtentSetX:
			(lastCharacterExtent x + 	(line justifiedPadFor: (spaceCount + 1))).
		^ true].

	true ifTrue: [^ true].
	"NOTE:  I find no value to the following code, and so have defeated it - DI"

	"See tabForDisplay for illumination on the following awfulness."
	leadingTab _ true.
	line first to: lastIndex - 1 do:
		[:index | (text at: index) ~= Character tab ifTrue: [leadingTab _ false]].
	(alignment ~= CharacterScanner justifiedCode or: [leadingTab])
		ifTrue:	[self lastCharacterExtentSetX: (actualTextStyle nextTabXFrom: currentX
					leftMargin: leftMargin rightMargin: rightMargin) -
						currentX]
		ifFalse:	[self lastCharacterExtentSetX:  (((currentX + (actualTextStyle tabWidth -
						(line justifiedTabDeltaFor: spaceCount))) -
							currentX) max: 0)].
	^ true! !

!CharacterBlockScanner methodsFor: 'stop conditions' stamp: 'jmv 7/29/2009 16:58'!
tab
	| currentX |
	currentX _ (alignment = CharacterScanner justifiedCode and: [self leadingTab not])
		ifTrue:		"imbedded tabs in justified text are weird"
			[destX + (actualTextStyle tabWidth - (line justifiedTabDeltaFor: spaceCount)) max: destX]
		ifFalse:
			[actualTextStyle
				nextTabXFrom: destX
				leftMargin: leftMargin
				rightMargin: rightMargin].
	lastSpaceOrTabExtent _ lastCharacterExtent copy.
	self lastSpaceOrTabExtentSetX: (currentX - destX max: 0).
	currentX >= characterPoint x
		ifTrue: 
			[lastCharacterExtent _ lastSpaceOrTabExtent copy.
			^ self crossedX].
	destX _ currentX.
	lastIndex _ lastIndex + 1.
	^false! !

!CharacterBlockScanner methodsFor: 'scanning' stamp: 'jmv 7/29/2009 16:58'!
characterBlockAtPoint: aPoint index: index in: textLine
	"This method is the Morphic characterBlock finder.  It combines
	MVC's characterBlockAtPoint:, -ForIndex:, and buildCharcterBlock:in:"
	| runLength lineStop done stopCondition |
	line _ textLine.
	rightMargin _ line rightMargin.
	lastIndex _ line first.
	self setStopConditions.		"also sets font"
	characterIndex _ index.  " == nil means scanning for point"
	characterPoint _ aPoint.
	(characterPoint == nil or: [characterPoint y > line bottom])
		ifTrue: [characterPoint _ line bottomRight].
	(text isEmpty or: [(characterPoint y < line top or: [characterPoint x < line left])
				or: [characterIndex ~~ nil and: [characterIndex < line first]]])
		ifTrue:	[^ (CharacterBlock new stringIndex: line first text: text
					topLeft: line leftMargin@line top extent: 0 @ actualTextStyle initialLineGrid)
					textLine: line].
	destX _ leftMargin _ line leftMarginForAlignment: alignment.
	destY _ line top.
	runLength _ text runLengthFor: line first.
	characterIndex ~~ nil
		ifTrue:	[lineStop _ characterIndex  "scanning for index"]
		ifFalse:	[lineStop _ line last  "scanning for point"].
	runStopIndex _ lastIndex + (runLength - 1) min: lineStop.
	lastCharacterExtent _ 0 @ line lineHeight.
	spaceCount _ 0.

	done  _ false.
	[done] whileFalse:
		[stopCondition _ self scanCharactersFrom: lastIndex to: runStopIndex
			in: text string rightX: characterPoint x
			stopConditions: stopConditions kern: kern.
		"see setStopConditions for stopping conditions for character block 	operations."
		self lastCharacterExtentSetX: (specialWidth == nil
			ifTrue: [font widthOf: (text at: lastIndex)]
			ifFalse: [specialWidth]).
		(self perform: stopCondition) ifTrue:
			[characterIndex == nil
				ifTrue: ["Result for characterBlockAtPoint: "
						^ (CharacterBlock new stringIndex: lastIndex
							text: text topLeft: characterPoint + (font descentKern @ 0)
							extent: lastCharacterExtent - (font baseKern @ 0))
									textLine: line]
				ifFalse: ["Result for characterBlockForIndex: "
						^ (CharacterBlock new stringIndex: characterIndex
							text: text topLeft: characterPoint + ((font descentKern) - kern @ 0)
							extent: lastCharacterExtent)
									textLine: line]]]! !


!CompositionScanner methodsFor: 'scanning' stamp: 'jmv 7/28/2009 18:14'!
composeFrom: startIndex inRectangle: lineRectangle
	firstLine: firstLine leftSide: leftSide rightSide: rightSide
	"Answer an instance of TextLineInterval that represents the next line in the paragraph."
	| runLength done stopCondition |
	"Set up margins"
	leftMargin _ lineRectangle left.
	destX _ spaceX _ leftMargin.
	rightMargin _ lineRectangle right.
	lastIndex _ startIndex.	"scanning sets last index"
	destY _ lineRectangle top.
	lineHeight _ baseline _ 0.  "Will be increased by setFont"
	self setStopConditions.	"also sets font"
	runLength _ text runLengthFor: startIndex.
	runStopIndex _ (lastIndex _ startIndex) + (runLength - 1).
	line _ (TextLine start: lastIndex stop: 0 internalSpaces: 0 paddingWidth: 0)
				rectangle: lineRectangle.
	spaceCount _ 0.
	leftMargin _ destX.
	line leftMargin: leftMargin.

	done _ false.
	[done]
		whileFalse: 
			[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 baseline: baseline]]! !

!CompositionScanner methodsFor: 'stop conditions' stamp: 'jmv 7/29/2009 16:57'!
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 withStyle: actualTextStyle.
				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! !

!CompositionScanner methodsFor: 'stop conditions' stamp: 'jmv 7/29/2009 16:57'!
tab
	"Advance destination x according to tab settings in the current
	textStyle. Answer whether the character has crossed the right edge of 
	the composition rectangle of the paragraph."

	destX _ actualTextStyle
				nextTabXFrom: destX leftMargin: leftMargin rightMargin: rightMargin.
	destX > rightMargin ifTrue:	[^self crossedX].
	lastIndex _ lastIndex + 1.
	^false
! !


!DisplayScanner methodsFor: 'private' stamp: 'jmv 7/29/2009 16:59'!
text: t textStyle: ts foreground: foreColor background: backColor fillBlt: blt ignoreColorChanges: shadowMode
	text _ t.
	initialTextStyle _ ts.
	actualTextStyle _ ts.
	foregroundColor _ paragraphColor _ foreColor.
	(backgroundColor _ backColor) isTransparent ifFalse:
		[fillBlt _ blt.
		fillBlt fillColor: backgroundColor].
	ignoreColorChanges _ shadowMode! !


!EntryField2LW methodsFor: 'drawing' stamp: 'jmv 7/30/2009 00:35'!
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 textStyle: font defaultTextStyle)
		characterBlockAtPoint: aPoint index: nil
		in: line.

	^ block stringIndex! !


!HaloMorph methodsFor: 'private' stamp: 'jmv 11/12/2006 22:12'!
addCircleHandles
	| box |
	simpleMode _ false.
	target isWorldMorph ifTrue: [^ self addHandlesForWorldHalos].

	self removeAllMorphs.  "remove old handles, if any"
	self bounds: target worldBoundsForHalo.  "update my size"
	box _ self basicBox.

	target addHandlesTo: self box: box.

	self addName.
	growingOrRotating _ false.
	self layoutChanged.
	self changed.
! !


!MorphExtension methodsFor: 'accessing - other properties' stamp: 'jmv 7/28/2009 18:15'!
privateOtherProperties: anIdentityDictionary 
	"private - change the receiver's otherProperties"
	otherProperties _ anIdentityDictionary ! !


!NewParagraph methodsFor: 'alignment' stamp: 'jmv 7/30/2009 11:59'!
centered 
	self textStyle: textStyle copy centered! !

!NewParagraph methodsFor: 'alignment' stamp: 'jmv 7/30/2009 11:58'!
justified 
	self textStyle: textStyle copy justified! !

!NewParagraph methodsFor: 'alignment' stamp: 'jmv 7/30/2009 11:59'!
leftFlush 
	self textStyle: textStyle copy leftFlush! !

!NewParagraph methodsFor: 'alignment' stamp: 'jmv 7/30/2009 11:59'!
rightFlush 
	self textStyle: textStyle copy rightFlush! !

!NewParagraph methodsFor: 'copying' stamp: 'jmv 7/30/2009 00:05'!
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 textStyle: textStyle
		lines: lines copy
		text: text deepCopy.
	^ new! !

!NewParagraph methodsFor: 'editing' stamp: 'jmv 7/29/2009 18:38'!
clickAt: clickPoint for: model controller: editor
	"Give sensitive text a chance to fire.  Display flash: (100@100 extent: 100@100)."
	| startBlock action target range boxes box |
	action _ false.
	startBlock _ self characterBlockAtPoint: clickPoint.
	(text attributesAt: startBlock stringIndex) 
		do: [:att | att mayActOnClick ifTrue:
				[(target _ model) ifNil: [target _ editor morph].
				range _ text rangeOf: att startingAt: startBlock stringIndex.
				boxes _ self selectionRectsFrom: (self characterBlockForIndex: range first) 
							to: (self characterBlockForIndex: range last+1).
				box _ boxes detect: [:each | each containsPoint: clickPoint] ifNone: [nil].
				box ifNotNil:
					[ box _ (editor transformFrom: nil) invertBoundsRect: box.
					editor morph allOwnersDo: [ :m | box _ box intersect: (m boundsInWorld) ].
					Utilities awaitMouseUpIn: box
						repeating: []
						ifSucceed: [(att actOnClickFor: target in: self at: clickPoint editor: editor) ifTrue: [action _ true]].
					Cursor currentCursor == Cursor webLink ifTrue:[Cursor normal show].
				]]].
	^ action! !

!NewParagraph methodsFor: 'editing' stamp: 'jmv 7/29/2009 22:19'!
replaceFrom: start to: stop with: aText
	"Edit the text, and then recompose the lines." 
	text replaceFrom: start to: stop with: aText.
	self recomposeFrom: start to: start + aText size - 1 delta: aText size - (stop-start+1)! !


!OneLineEditorMorph methodsFor: 'drawing' stamp: 'jmv 7/30/2009 00:35'!
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 textStyle: font defaultTextStyle)
		characterBlockAtPoint: aPoint index: nil
		in: line.

	^ block stringIndex! !


!PluggableTextMorph methodsFor: 'initialization' stamp: 'jmv 7/30/2009 00:35'!
font: aFont
	textMorph setTextStyle: aFont defaultTextStyle! !


!PopUpMenu methodsFor: 'accessing' stamp: 'jmv 7/28/2009 15:57'!
frameHeight
	"Designed to avoid the entire frame computation (includes MVC form),
	since the menu may well end up being displayed in Morphic anyway."
	| nItems |
	nItems _ 1 + (labelString occurrencesOf: Character cr).
	^ (nItems * MenuStyle initialLineGrid) + 4 "border width"! !

!PopUpMenu methodsFor: 'basic control sequence' stamp: 'jmv 7/28/2009 15:57'!
startUpSegmented: segmentHeight withCaption: captionOrNil at: location allowKeyboard: aBoolean
	"This menu is too big to fit comfortably on the screen.
	Break it up into smaller chunks, and manage the relative indices.
	Inspired by a special-case solution by Reinier van Loon.  The boolean parameter indicates whether the menu should be given keyboard focus (if in morphic)"

"
(PopUpMenu labels: (String streamContents: [:s | 1 to: 100 do: [:i | s print: i; cr]. s skip: -1])
		lines: (5 to: 100 by: 5)) startUpWithCaption: 'Give it a whirl...'.
"
	| nLines nLinesPer allLabels from to subset subLines index |
	allLabels := labelString findTokens: Character cr asString.
	nLines _ allLabels size.
	lineArray ifNil: [lineArray _ Array new].
	nLinesPer _ segmentHeight // MenuStyle initialLineGrid - 3.
	from := 1.
	[ true ] whileTrue:
		[to := (from + nLinesPer) min: nLines.
		subset := allLabels copyFrom: from to: to.
		subset add: (to = nLines ifTrue: ['start over...'] ifFalse: ['more...'])
			before: subset first.
		subLines _ lineArray select: [:n | n >= from] thenCollect: [:n | n - (from-1) + 1].
		subLines _ (Array with: 1) , subLines.
		index := (PopUpMenu labels: subset asStringWithCr lines: subLines)
					startUpWithCaption: captionOrNil at: location allowKeyboard: aBoolean.
		index = 1
			ifTrue: [from := to + 1.
					from > nLines ifTrue: [ from := 1 ]]
			ifFalse: [index = 0 ifTrue: [^ 0].
					^ from + index - 2]]! !


!PopUpMenu class methodsFor: 'class initialization' stamp: 'jmv 7/30/2009 00:29'!
setMenuFontTo: aFont
	"Set the menu font as indicated"

	MenuStyle _ TextStyle centeredWithFont: aFont.
	self allSubInstancesDo: [:m | m rescan]! !


!Preferences class methodsFor: 'fonts' stamp: 'jmv 7/30/2009 00:37'!
setSystemFontTo: aFont
	"Establish the default text font and style"

	aFont ifNil: [^ self].
	StrikeFont default: aFont.
	TextStyle default: aFont defaultTextStyle! !

!Preferences class methodsFor: 'halos' stamp: 'jmv 7/28/2009 23:06'!
iconicHaloSpecifications
	"Answer an array that characterizes the locations, colors, icons, and selectors of the halo handles that may be used in the iconic halo scheme"

	"Preferences resetHaloSpecifications"

	^ #(
	"  	selector				horiz			vert			color info						icon key
		---------					------			-----------		-------------------------------		---------------"
	(addCollapseHandle:		left				topCenter		(tan)							'Halo-Collapse')
	(addDebugHandle:			right			topCenter		(blue	veryMuchLighter)		'Halo-Debug')
	(addDismissHandle:			left				top				(red		muchLighter)		'Halo-Dismiss')
	(addRotateHandle:			left				bottom			(blue)							'Halo-Rot')
	(addMenuHandle:			leftCenter		top				(red)							'Halo-Menu')
	(addGrabHandle:			center			top				(black)							'Halo-Grab')
	(addDragHandle:			rightCenter	top				(brown)							'Halo-Drag')
	(addDupHandle:			right			top				(green)							'Halo-Dup')	
	(addHelpHandle:			center			bottom			(lightBlue)						'Halo-Help')
	(addGrowHandle:			right			bottom			(yellow)						'Halo-Scale')
	(addFontSizeHandle:		leftCenter		bottom			(lightGreen)					'Halo-FontSize')
	(addFontStyleHandle:		center			bottom			(lightRed)						'Halo-FontStyle')
	(addFontEmphHandle:		rightCenter	bottom			(lightBrown darker)			'Halo-FontEmph')
	(addRecolorHandle:		right			bottomCenter	(magenta darker)				'Halo-Recolor')
		) ! !


!SimpleEditor methodsFor: 'mvc compatibility' stamp: 'jmv 7/29/2009 22:23'!
zapSelectionWith: aString

	| start stop |
	self deselect.
	start _ self startIndex.
	stop _ self stopIndex.
	(start = stop and: [aString size = 0]) ifFalse: [
		string _ string copyReplaceFrom: start to: stop-1 with: aString.
		self
			markIndex: start; 
			pointIndex: start + aString size].

	self userHasEdited  " -- note text now dirty"! !

!SimpleEditor methodsFor: 'typing support' stamp: 'jmv 7/29/2009 22:34'!
insertTypeAhead: typeAhead
	typeAhead position = 0 ifFalse: [
		self zapSelectionWith: typeAhead contents.
		typeAhead reset.
		self unselect]! !

!SimpleEditor methodsFor: 'typing support' stamp: 'jmv 7/30/2009 00:45'!
openTypeIn
	"Set up beginTypeInIndex to keep track of the leftmost backspace."

	beginTypeInIndex ifNil: [
		beginTypeInIndex _ self startIndex ]! !


!StringMorph methodsFor: 'editing' stamp: 'jmv 7/30/2009 00:36'!
launchMiniEditor: evt 
	| textMorph |
	hasFocus := true.	"Really only means edit in progress for this morph"
	textMorph := StringMorphEditor new contentsAsIs: contents.
	textMorph setTextStyle: self fontToUse defaultTextStyle.
	textMorph bounds: (self bounds expandBy: 0 @ 2).
	self addMorphFront: textMorph.
	evt hand newMouseFocus: textMorph.
	self flag: #arNote.	"Why???"
"
	evt hand newKeyboardFocus: textMorph."
	textMorph editor selectFrom: 1 to: textMorph paragraph text string size! !


!TestRunner methodsFor: 'interface opening' stamp: 'jmv 7/28/2009 15:57'!
buildTestsList
	| column offset buttonRow |
	column _ AlignmentMorph proportional.
	testsList _ PluggableListMorphOfMany
				on: self
				list: #tests
				primarySelection: #selectedSuite
				changePrimarySelection: #selectedSuite:
				listSelection: #listSelectionAt:
				changeListSelection: #listSelectionAt:put:
				menu: #listMenu:shifted:.
	testsList autoDeselect: false.
	offset _ 0.
	self wantsOptionalButtons
		ifTrue: [offset _ TextStyle default initialLineGrid + 16 ].
	column
		addMorph: testsList
		fullFrame: (LayoutFrame
				fractions: (0 @ 0 corner: 1 @ 1)
				offsets: (0 @ 0 corner: 0 @ offset negated)).
	self wantsOptionalButtons
		ifTrue: [
			buttonRow _ self optionalButtonRow.
			buttonRow
				color: (Display depth <= 8
						ifTrue: [Color transparent]
						ifFalse: [Color gray alpha: 0.2]).
			Preferences alternativeWindowLook
				ifTrue: [
					buttonRow color: Color transparent].
			column
				addMorph: buttonRow
				fullFrame: (LayoutFrame
						fractions: (0 @ 1 corner: 1 @ 1)
						offsets: (0 @ (offset - 1) negated corner: 0 @ 0))].
	^ column! !


!Text methodsFor: 'emphasis' stamp: 'jmv 7/29/2009 17:05'!
attributesAt: characterIndex
	"Answer the code for characters in the run beginning at characterIndex."
	| attributes |
	self size = 0
		ifTrue: [^ #()].  "null text tolerates access"
	attributes _ runs at: characterIndex.
	^ attributes! !

!Text methodsFor: 'emphasis' stamp: 'jmv 7/28/2009 23:14'!
fontAt: characterIndex withStyle: aTextStyle
	"Answer the font for characters in the run beginning at characterIndex."
	| attributes font |
	self size = 0 ifTrue: [^ aTextStyle font].	"null text tolerates access"
	attributes _ runs at: characterIndex.
	font _ aTextStyle font.  "default"
	attributes do: 
		[:att | att forFontInStyle: aTextStyle do: [:f | font _ f]].
	^ font! !

!Text methodsFor: 'attributes' stamp: 'jmv 7/29/2009 17:34'!
unembellished 
	"Return true if the only emphases are  bold"
	| bold |
	bold _ TextEmphasis bold.
	Preferences ignoreStyleIfOnlyBold ifFalse: [
		^ runs values isEmpty].

	"If preference is set, then ignore any  bold"
	runs withStartStopAndValueDo: [ :start :stop :emphArray |
		emphArray do: [:emph | 
			(bold = emph) ifFalse: [^ false]]].
	^ true! !


!Text class methodsFor: 'instance creation' stamp: 'jmv 7/29/2009 16:35'!
string: aString 
	"Answer an instance of me whose characters are those of the argument, aString."

	^ self string: aString attributes: #()! !


!TextComposer methodsFor: 'as yet unclassified' stamp: 'jmv 7/28/2009 15:57'!
composeLinesFrom: argStart to: argStop delta: argDelta into: argLinesCollection priorLines: argPriorLines atY: argStartY textStyle: argTextStyle text: argText container: argContainer

	lines _ argLinesCollection.
	theTextStyle _ argTextStyle.
	theText _ argText.
	theContainer _ argContainer.
	deltaCharIndex _ argDelta.
	currCharIndex _ startCharIndex _ argStart.
	stopCharIndex _ argStop.
	prevLines _ argPriorLines.
	currentY _ argStartY.
	defaultLineHeight _ theTextStyle initialLineGrid.
	maxRightX _ theContainer left.
	possibleSlide _ stopCharIndex < theText size and: [theContainer isMemberOf: Rectangle].
	nowSliding _ false.
	prevIndex _ 1.
	scanner _ CompositionScanner new text: theText textStyle: theTextStyle.
	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 7/30/2009 00:14'!
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 textStyle 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 7/30/2009 00:23'!
changeStyle
	"Let user change styles for the current text pane."
	| names reply style current menuList |

	current _ paragraph textStyle.
	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 textStyle: style.
		paragraph composeAll.
		self recomputeSelection].
	^ true! !

!TextEditor methodsFor: 'editing keys' stamp: 'jmv 7/29/2009 22:51'!
changeEmphasis: characterStream 
	"Change the emphasis of the current selection or prepare to accept characters with the change in emphasis. Emphasis change amounts to a font change.  Keeps typeahead."

	"control 0..9 -> 0..9"

	| keyCode attribute oldAttributes index thisSel colors |
	keyCode := ('0123456789-=' indexOf: sensor keyboard ifAbsent: [1]) - 1.
	oldAttributes := paragraph text attributesAt: self pointIndex.
	thisSel := self selection.

	"Decipher keyCodes for Command 0-9..."
	"
	(keyCode between: 1 and: 5) 
		ifTrue: [attribute := TextFontChange fontNumber: keyCode].
	"
	keyCode = 6 
		ifTrue: [
			colors := #(#black #magenta #red #yellow #green #blue #cyan #white).
			index := (PopUpMenu 
						labelArray: colors , #('choose color...' )
						lines: (Array with: colors size + 1)) startUp.
			index = 0 ifTrue: [^true].
			index <= colors size 
				ifTrue: [attribute := TextColor color: (Color perform: (colors at: index))]
				ifFalse: [
					index := index - colors size - 1.	"Re-number!!!!!!"
					index = 0 ifTrue: [attribute := self chooseColor].
					thisSel ifNil: [^true]	"Could not figure out what to link to"]].
	(keyCode between: 7 and: 11) 
		ifTrue: [
			sensor leftShiftDown 
				ifTrue: [
					keyCode = 10 ifTrue: [attribute := TextKern kern: -1].
					keyCode = 11 ifTrue: [attribute := TextKern kern: 1]]
				ifFalse: [
					attribute := TextEmphasis 
								perform: (#(#bold #italic #narrow #underlined #struckOut) at: keyCode - 6).
					oldAttributes 
						do: [:att | (att dominates: attribute) ifTrue: [attribute turnOff]]]].
	keyCode = 0 ifTrue: [attribute := TextEmphasis normal].
	beginTypeInBlock ~~ nil 
		ifTrue: [
			"only change emphasisHere while typing"
			self insertTypeAhead: characterStream.
			emphasisHere := Text addAttribute: attribute toArray: oldAttributes.
			^true].
	self replaceSelectionWith: (thisSel asText addAttribute: attribute).
	^true! !

!TextEditor methodsFor: 'editing keys' stamp: 'jmv 7/29/2009 22:37'!
enclose: characterStream
	"Insert or remove bracket characters around the current selection.
	 Flushes typeahead."

	| char left right startIndex stopIndex oldSelection which text |
	char _ sensor keyboard.
	self closeTypeIn.
	startIndex _ self startIndex.
	stopIndex _ self stopIndex.
	oldSelection _ self selection.
	which _ '([<{"''' indexOf: char ifAbsent: [ ^true ].
	left _ '([<{"''' at: which.
	right _ ')]>}"''' at: which.
	text _ paragraph text.
	((startIndex > 1 and: [stopIndex <= text size])
			and: [ (text at: startIndex-1) = left and: [(text at: stopIndex) = right]])
		ifTrue: [
			"already enclosed; strip off brackets"
			self selectFrom: startIndex-1 to: stopIndex.
			self replaceSelectionWith: oldSelection]
		ifFalse: [
			"not enclosed; enclose by matching brackets"
			self replaceSelectionWith:
				(Text string: (String with: left), oldSelection string, (String with: right) attributes: emphasisHere).
			self selectFrom: startIndex+1 to: stopIndex].
	^true! !

!TextEditor methodsFor: 'editing keys' stamp: 'jmv 7/29/2009 18:37'!
hiddenInfo
	"In TextLinks, TextDoits, TextColor, and TextURLs, there is hidden info.  Return the entire string that was used by Cmd-6 to create this text attribute.  Usually enclosed in < >."

	| attrList |
	attrList _ paragraph text attributesAt: (self pointIndex + self markIndex)//2.
	attrList do: [:attr |
		(attr isKindOf: TextAction) ifTrue:
			[^ self selection asString, '<', attr info, '>']].
	"If none of the above"
	attrList do: [:attr |
		attr class == TextColor ifTrue:
			[^ self selection asString, '<', attr color printString, '>']].
	^ self selection asString, '[No hidden info]'! !

!TextEditor methodsFor: 'editing keys' stamp: 'jmv 7/29/2009 18:37'!
setEmphasis: emphasisSymbol
	"Change the emphasis of the current selection."

	| oldAttributes attribute |
	oldAttributes _ paragraph text attributesAt: self selectionInterval first.

	attribute _ TextEmphasis perform: emphasisSymbol.
	(emphasisSymbol == #normal) 
		ifFalse:	[oldAttributes do:	
			[:att | (att dominates: attribute) ifTrue: [attribute turnOff]]].
	self replaceSelectionWith: (self selection addAttribute: attribute)! !

!TextEditor methodsFor: 'editing keys' stamp: 'jmv 7/29/2009 22:37'!
shiftEnclose: characterStream
	"Insert or remove bracket characters around the current selection.
	 Flushes typeahead."

	| char left right startIndex stopIndex oldSelection which text |
	char _ sensor keyboard.
	char = $9 ifTrue: [ char _ $( ].
	char = $, ifTrue: [ char _ $< ].
	char = $[ ifTrue: [ char _ ${ ].
	char = $' ifTrue: [ char _ $" ].
	char asciiValue = 27 ifTrue: [ char _ ${ ].	"ctrl-["

	self closeTypeIn.
	startIndex _ self startIndex.
	stopIndex _ self stopIndex.
	oldSelection _ self selection.
	which _ '([<{"''' indexOf: char ifAbsent: [1].
	left _ '([<{"''' at: which.
	right _ ')]>}"''' at: which.
	text _ paragraph text.
	((startIndex > 1 and: [stopIndex <= text size])
			and: [ (text at: startIndex-1) = left and: [(text at: stopIndex) = right]])
		ifTrue: [
			"already enclosed; strip off brackets"
			self selectFrom: startIndex-1 to: stopIndex.
			self replaceSelectionWith: oldSelection]
		ifFalse: [
			"not enclosed; enclose by matching brackets"
			self replaceSelectionWith:
				(Text string: (String with: left), oldSelection string, (String with: right) attributes: emphasisHere).
			self selectFrom: startIndex+1 to: stopIndex].
	^true! !

!TextEditor methodsFor: 'editing keys' stamp: 'jmv 7/29/2009 22:37'!
swapChars: characterStream 
	"Triggered byCmd-Y;.  Swap two characters, either those straddling the insertion point, or the two that comprise the selection.  Suggested by Ted Kaehler.  "

	| currentSelection aString chars |
	sensor keyboard.		"flush the triggering cmd-key character"
	(chars _ self selection) size = 0
		ifTrue:
			[currentSelection _ self pointIndex.
			self selectMark: currentSelection - 1 point: currentSelection]
		ifFalse:
			[chars size = 2
				ifFalse:
					[morph flash. ^ true]
				ifTrue:
					[currentSelection _ self pointIndex - 1]].
	aString _ self selection string.
	self replaceSelectionWith: (Text string: aString reversed attributes: emphasisHere).
	self selectAt: currentSelection + 1.
	^ true! !

!TextEditor methodsFor: 'menu messages' stamp: 'jmv 7/29/2009 22:20'!
setAlignment: aSymbol
	| attr interval |
	attr _ TextAlignment perform: aSymbol.
	interval _ self encompassLine: self selectionInterval.
	paragraph 
		replaceFrom: interval first 
		to: interval last 
		with: ((paragraph text copyFrom: interval first to: interval last) addAttribute: attr)! !

!TextEditor methodsFor: 'mvc compatibility' stamp: 'jmv 7/29/2009 22:49'!
zapSelectionWith: aText

	| start stop |
	self deselect.
	start _ self startIndex.
	stop _ self stopIndex.
	(aText isEmpty and: [stop > start]) ifTrue: [
		"If deleting, then set emphasisHere from 1st character of the deletion"
		emphasisHere _ (paragraph text attributesAt: start) select: [:att | att mayBeExtended]].
	(start = stop and: [ aText size = 0 ]) ifFalse: [
		paragraph replaceFrom: start to: stop - 1 with: aText.
		self markIndex: start; pointIndex: start + aText size.
		UndoInterval _ otherInterval _ self selectionInterval].

	self userHasEdited  " -- note text now dirty"! !

!TextEditor methodsFor: 'typing support' stamp: 'jmv 7/29/2009 22:47'!
backTo: startIndex
	"During typing, backspace to startIndex.  Deleted characters fall into three
	 clusters, from left to right in the text: (1) preexisting characters that were
	 backed over; (2) newly typed characters that were backed over (excluding
	 typeahead, which never even appears); (3) preexisting characters that
	 were highlighted before typing began.  If typing has not yet been opened,
	 open it and watch for the first and third cluster.  If typing has been opened,
	 watch for the first and second cluster.  Save characters from the first and third
	 cluster in UndoSelection.  Tally characters from the first cluster in UndoMessage's parameter.
	 Delete all the clusters.  Do not alter Undoer or UndoInterval (except via
	 openTypeIn).  The code is shorter than the comment."

	| saveLimit newBackovers |
	saveLimit _ beginTypeInBlock
		ifNil: [self openTypeIn. UndoSelection _ self nullText. self stopIndex]
		ifNotNil: [self startOfTyping].
	self markIndex: startIndex.
	startIndex < saveLimit ifTrue: [
		newBackovers _ self startOfTyping - startIndex.
		beginTypeInBlock _ self startIndex.
		UndoSelection replaceFrom: 1 to: 0 with:
			(paragraph text copyFrom: startIndex to: saveLimit - 1).
		UndoMessage argument: (UndoMessage argument ifNil: [1]) + newBackovers].
	self zapSelectionWith: self nullText.
	self unselect! !

!TextEditor methodsFor: 'typing support' stamp: 'jmv 7/29/2009 22:47'!
closeTypeIn
	"See comment in openTypeIn.  It is important to call closeTypeIn before executing
	 any non-typing key, making a new selection, etc.  It is called automatically for
	 menu commands.
	 Typing commands can call 'closeTypeIn: aCharacterStream' instead of this to
	 save typeahead.  Undoer & Redoer: undoAndReselect:redoAndReselect:."

	| begin stop |
	beginTypeInBlock == nil ifFalse: [
		(UndoMessage sends: #noUndoer) ifTrue: "should always be true, but just in case..."
			[begin _ self startOfTyping.
			stop _ self stopIndex.
			self undoer: #undoAndReselect:redoAndReselect:
				with: (begin + UndoMessage argument to: begin + UndoSelection size - 1)
				with: (stop to: stop - 1).
			UndoInterval _ begin to: stop - 1].
		beginTypeInBlock _ nil]! !

!TextEditor methodsFor: 'typing support' stamp: 'jmv 7/29/2009 22:53'!
insertTypeAhead: typeAhead
	typeAhead position = 0 ifFalse: [
		self zapSelectionWith: (Text string: typeAhead contents attributes: emphasisHere).
		typeAhead reset.
		self unselect]! !

!TextEditor methodsFor: 'typing support' stamp: 'jmv 7/30/2009 00:46'!
openTypeIn
	"Set up UndoSelection to null text (to be added to by readKeyboard and backTo:),
	 beginTypeInBlock to keep track of the leftmost backspace, and UndoParameter to tally
	 how many deleted characters were backspaced over rather than 'cut'.
	 You can't undo typing until after closeTypeIn."

	beginTypeInBlock ifNil: [
		UndoSelection _ self nullText.
		self undoer: #noUndoer with: 0.
		beginTypeInBlock _ self startIndex]! !

!TextEditor methodsFor: 'typing support' stamp: 'jmv 7/29/2009 23:06'!
readKeyboard
	"Key struck on the keyboard. Find out which one and, if special, carry 
	out the associated special action. Otherwise, add the character to the 
	stream of characters.  Undoer & Redoer: see closeTypeIn."

	| typeAhead char |
	typeAhead _ WriteStream on: (String new: 128).
	[ sensor keyboardPressed ] whileTrue: [
		self deselect.
		[ sensor keyboardPressed ] whileTrue: [
			char _ sensor keyboardPeek.
			(self dispatchOnCharacter: char with: typeAhead) ifTrue: [
				self doneTyping.
				self storeSelectionInParagraph.
				^self].
			self openTypeIn].
		self hasSelection ifTrue: [ "save highlighted characters"
			UndoSelection _ self selection].
		self zapSelectionWith: 
			(Text string: typeAhead contents attributes: emphasisHere).
		typeAhead reset.
		self unselect].
	self storeSelectionInParagraph! !

!TextEditor methodsFor: 'typing support' stamp: 'jmv 7/29/2009 18:37'!
setEmphasisHere

	emphasisHere _ (paragraph text attributesAt: (self pointIndex - 1 max: 1))
					select: [:att | att mayBeExtended]! !

!TextEditor methodsFor: 'private' stamp: 'jmv 7/29/2009 22:36'!
nullText

	^Text string: '' attributes: emphasisHere! !


!SmalltalkEditor methodsFor: 'editing keys' stamp: 'jmv 7/29/2009 22:50'!
changeEmphasis: characterStream 
	"Change the emphasis of the current selection or prepare to accept characters with the change in emphasis. Emphasis change amounts to a font change.  Keeps typeahead."

	"control 0..9 -> 0..9"

	| keyCode attribute oldAttributes index thisSel colors extras |
	keyCode := ('0123456789-=' indexOf: sensor keyboard ifAbsent: [1]) - 1.
	oldAttributes := paragraph text attributesAt: self pointIndex.
	thisSel := self selection.

	"Decipher keyCodes for Command 0-9..."
	"
	(keyCode between: 1 and: 5) 
		ifTrue: [attribute := TextFontChange fontNumber: keyCode].
	"
	keyCode = 6 
		ifTrue: [
			colors := #(#black #magenta #red #yellow #green #blue #cyan #white).
			extras := #('Link to comment of class' 'Link to definition of class' 'Link to hierarchy of class' 'Link to method').
			index := (PopUpMenu 
						labelArray: colors , #('choose color...' 'Do it' 'Print it') , extras 
								, #('be a web URL link' 'Edit hidden info' 'Copy hidden info')
						lines: (Array with: colors size + 1)) startUp.
			index = 0 ifTrue: [^true].
			index <= colors size 
				ifTrue: [attribute := TextColor color: (Color perform: (colors at: index))]
				ifFalse: 
					[index := index - colors size - 1.	"Re-number!!!!!!"
					index = 0 ifTrue: [attribute := self chooseColor].
					index = 1 
						ifTrue: 
							[attribute := TextDoIt new.
							thisSel := attribute analyze: self selection asString].
					index = 2 
						ifTrue: 
							[attribute := TextPrintIt new.
							thisSel := attribute analyze: self selection asString].
					extras size = 0 & (index > 2) ifTrue: [index := index + 5].	"skip those"
					index = 3 
						ifTrue: 
							[attribute := TextLink new.
							thisSel := attribute analyze: self selection asString with: 'Comment'].
					index = 4 
						ifTrue: 
							[attribute := TextLink new.
							thisSel := attribute analyze: self selection asString with: 'Definition'].
					index = 5 
						ifTrue: 
							[attribute := TextLink new.
							thisSel := attribute analyze: self selection asString with: 'Hierarchy'].
					index = 6 
						ifTrue: 
							[attribute := TextLink new.
							thisSel := attribute analyze: self selection asString].
					index = 7 
						ifTrue: 
							[attribute := TextURL new.
							thisSel := attribute analyze: self selection asString].
					index = 8 
						ifTrue: 
							["Edit hidden info"

							thisSel := self hiddenInfo.	"includes selection"
							attribute := TextEmphasis normal].
					index = 9 
						ifTrue: 
							["Copy hidden info"

							self copyHiddenInfo.
							^true].	"no other action"
					thisSel ifNil: [^true]	"Could not figure out what to link to"]].
	(keyCode between: 7 and: 11) 
		ifTrue: [
			sensor leftShiftDown 
				ifTrue: 
					[keyCode = 10 ifTrue: [attribute := TextKern kern: -1].
					keyCode = 11 ifTrue: [attribute := TextKern kern: 1]]
				ifFalse: 
					[attribute := TextEmphasis 
								perform: (#(#bold #italic #narrow #underlined #struckOut) at: keyCode - 6).
					oldAttributes 
						do: [:att | (att dominates: attribute) ifTrue: [attribute turnOff]]]].
	keyCode = 0 ifTrue: [attribute := TextEmphasis normal].
	beginTypeInBlock ~~ nil 
		ifTrue: [
			"only change emphasisHere while typing"
			self insertTypeAhead: characterStream.
			emphasisHere := Text addAttribute: attribute toArray: oldAttributes.
			^true].
	attribute ifNotNil: [
		self replaceSelectionWith: (thisSel asText addAttribute: attribute) ].
	^true! !


!TextMorph methodsFor: 'accessing' stamp: 'jmv 7/29/2009 18:38'!
newContents: stringOrText 
	"Accept new text contents."
	| newText embeddedMorphs |
	"If my text is all the same font, use the font for my new contents"
	newText _ stringOrText isString ifTrue: [ | textSize |
		(text notNil
		  and: [ (textSize _ text size) > 0
		    and: [ (text runLengthFor: 1) = textSize ]]) ifTrue: [ | attribs |
			attribs _ text attributesAt: 1.
			Text string: stringOrText copy attributes: attribs.
		]
		ifFalse: [ Text fromString: stringOrText copy ]
	]
	ifFalse: [ stringOrText copy asText.	"should be veryDeepCopy?" ].

	text = newText ifTrue: [^ self].	"No substantive change"
	text ifNotNil: [(embeddedMorphs _ text embeddedMorphs)
			ifNotNil: 
				[self removeAllMorphsIn: embeddedMorphs.
				embeddedMorphs do: [:m | m delete]]].

	text _ newText.

	"add all morphs off the visible region; they'll be moved into the right 
	place when they become visible. (this can make the scrollable area too 
	large, though)"
	newText embeddedMorphs do: 
		[:m | 
		self addMorph: m.
		m position: -1000 @ 0].
	self releaseParagraph.
	"update the paragraph cache"
	self paragraph.
	"re-instantiate to set bounds"
	self world ifNotNil: [self world startSteppingSubmorphsOf: self]! !

!TextMorph methodsFor: 'anchors' stamp: 'jmv 7/29/2009 22:22'!
anchorMorph: aMorph at: aPoint type: anchorType
	| relPt index newText block |
	aMorph owner == self ifTrue:[self removeMorph: aMorph].
	aMorph textAnchorType: nil.
	aMorph relativeTextAnchorPosition: nil.
	self addMorphFront: aMorph.
	aMorph textAnchorType: anchorType.
	aMorph relativeTextAnchorPosition: nil.
	anchorType == #document ifTrue:[^self].
	relPt _ self transformFromWorld globalPointToLocal: aPoint.
	index _ (self paragraph characterBlockAtPoint: relPt) stringIndex.
	newText _ Text string: (String value: 1) attribute: (TextAnchor new anchoredMorph: aMorph).
	anchorType == #inline ifTrue:[
		self paragraph replaceFrom: index to: index-1 with: newText.
	] ifFalse:[
		index _ index min: paragraph text size.
		index _ paragraph text string lastIndexOf: Character cr startingAt: index ifAbsent:[0].
		block _ paragraph characterBlockForIndex: index+1.
		aMorph relativeTextAnchorPosition: (relPt x - bounds left) @ (relPt y - block top ).
		self paragraph replaceFrom: index+1 to: index with: newText.
	].
	self fit.! !

!TextMorph methodsFor: 'containment' stamp: 'jmv 7/28/2009 15:57'!
fillingOnOff
	"Establish a container for this text, with opposite filling status"
	self setContainer:
	(container
		ifNil: [TextContainer new for: self minWidth: textStyle 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 7/28/2009 15:57'!
occlusionsOnOff
	"Establish a container for this text, with opposite occlusion avoidance status"
	self setContainer:
	(container
	ifNil: [(TextContainer new for: self minWidth: textStyle 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 7/30/2009 00:05'!
copy
	"jmv note We don't copy TextStyles anymore. We want to preserve their identity."
	^ super copy
		text: text copy 
		textStyle: textStyle 
		wrap: wrapFlag 
		color: color! !

!TextMorph methodsFor: 'editing' stamp: 'jmv 7/29/2009 18:37'!
enterClickableRegion: evt
	| index isLink |
	evt hand hasSubmorphs ifTrue:[^self].
	evt hand temporaryCursor ifNotNil:[^self].
	paragraph ifNotNil:[
		index _ (paragraph characterBlockAtPoint: evt position) stringIndex.
		isLink _ (paragraph text attributesAt: index) 
					anySatisfy:[:attr| attr mayActOnClick].
		isLink ifTrue:[Cursor webLink show] ifFalse:[Cursor normal show].
	].
! !

!TextMorph methodsFor: 'geometry' stamp: 'jmv 7/28/2009 15:57'!
defaultLineHeight
	^ textStyle initialLineGrid! !

!TextMorph methodsFor: 'geometry' stamp: 'jmv 7/28/2009 15:57'!
minimumExtent
	| minExt |
	textStyle ifNil: [^ 9@16].
	borderWidth ifNil: [^ 9@16].
	minExt _ (9@(textStyle initialLineGrid+2)) + (borderWidth*2).
	margins ifNil: [^ minExt].
	^ ((0@0 extent: minExt) expandBy: margins) extent! !

!TextMorph methodsFor: 'initialization' stamp: 'jmv 7/30/2009 00:52'!
initialize
	"jmv note: We don't copy TextStyles all over the place anymore. We want to preserve their identity."
	super initialize.
	borderWidth _ 0.
	textStyle _ TextStyle default.
	wrapFlag _ true.
! !

!TextMorph methodsFor: 'menu' stamp: 'jmv 7/28/2009 16:40'!
addCustomMenuItems: aCustomMenu hand: aHandMorph 
	"Add text-related menu items to the menu"

	| outer |
	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
	aCustomMenu 
		addUpdating: #autoFitString
		target: self
		action: #autoFitOnOff.
	aCustomMenu 
		addUpdating: #wrapString
		target: self
		action: #wrapOnOff.
	aCustomMenu add: 'text margins...' translated action: #changeMargins:.
	Preferences simpleMenus
		ifFalse: 
			[aCustomMenu add: 'code pane menu...' translated
				action: #yellowButtonActivity.
			aCustomMenu add: 'code pane shift menu....' translated
				action: #shiftedYellowButtonActivity].
	outer := self owner.
	((outer isKindOf: PolygonMorph) and: [outer isOpen]) 
		ifFalse: 
			[(container isNil or: [container fillsOwner not]) 
				ifTrue: 
					[aCustomMenu add: 'fill owner''s shape' translated action: #fillingOnOff]
				ifFalse: 
					[aCustomMenu add: 'rectangular bounds' translated action: #fillingOnOff].
			(container isNil or: [container avoidsOcclusions not]) 
				ifTrue: 
					[aCustomMenu add: 'avoid occlusions' translated action: #occlusionsOnOff]
				ifFalse: 
					[aCustomMenu add: 'ignore occlusions' translated action: #occlusionsOnOff]]! !

!TextMorph methodsFor: 'scripting access' stamp: 'jmv 7/29/2009 22:21'!
insertCharacters: aSource
	"Insert the characters from the given source at my current cursor position"

	| aLoc |
	aLoc _ self cursor.
	paragraph replaceFrom: aLoc to: (aLoc - 1) with: aSource asText.
	self updateFromParagraph  ! !

!TextMorph methodsFor: 'private' stamp: 'jmv 7/28/2009 15:57'!
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 @ textStyle 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 7/29/2009 23:51'!
paragraph
	"Paragraph instantiation is lazy -- create it only when needed"
	paragraph ifNotNil: [^ paragraph].

self setProperty: #CreatingParagraph toValue: true.

	self setDefaultContentsIfNil.

	"...Code here to recreate the paragraph..."
	paragraph _ (self paragraphClass new textOwner: self owner).
	paragraph focused: self hasKeyboardFocus.
	paragraph
		compose: text
		style: textStyle
		in: self container.
	wrapFlag ifFalse: [
		"Was given huge container at first... now adjust"
		paragraph adjustRightX].
	self fit.
self removeProperty: #CreatingParagraph.


	^ paragraph! !

!TextMorph methodsFor: 'private' stamp: 'jmv 7/29/2009 22:21'!
removedMorph: aMorph
	| range |
	range _ text find: (TextAnchor new anchoredMorph: aMorph).
	range ifNotNil: [
		self paragraph replaceFrom: range first to: range last with: Text new.
		self fit].
	aMorph textAnchorType: nil.
	aMorph relativeTextAnchorPosition: nil.
	super removedMorph: aMorph.! !

!TextMorph methodsFor: 'private' stamp: 'jmv 7/30/2009 00:22'!
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 textStyle = textStyle 
		ifTrue: [self fit]
		ifFalse: [
			newStyle := paragraph textStyle.
			self 
				text: text textStyle: newStyle;	"Set new style if any"
				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]! !


!TextStyle methodsFor: 'accessing' stamp: 'jmv 7/28/2009 16:58'!
font: aFont

	font _ aFont.
	alignment _ 0.
	tabsArray _ TextStyle defaultTabsArray! !

!TextStyle methodsFor: 'accessing' stamp: 'jmv 7/28/2009 16:45'!
initialLineGrid
	"Answer the relative space between lines of a paragraph in the style of 
	the receiver. This is only valid if no font change has been applied!!"

	^font height! !


!TextStyle class methodsFor: 'instance creation' stamp: 'jmv 7/30/2009 00:29'!
centeredWithFont: aFont
	| textStyle |
	textStyle _ self new.
	textStyle
		name: aFont name, ' centered';
		font: aFont;
		centered.
	^textStyle! !

!TextStyle class methodsFor: 'examples' stamp: 'jmv 7/29/2009 00:17'!
createExamples
	"
	TextStyle createExamples
	"
	| dejaVu18 dejaVu14 dejaVu11 dejaVu10 heading1 heading2 heading3 emphasized normal |

	dejaVu18 _ AbstractFont familyName: 'DejaVu' pointSize: 18.
	dejaVu14 _ AbstractFont familyName: 'DejaVu' pointSize: 14.
	dejaVu11 _ AbstractFont familyName: 'DejaVu' pointSize: 11.
	dejaVu10 _ AbstractFont familyName: 'DejaVu' pointSize: 10.
	
	heading1 _ TextStyle withFont: dejaVu18 bold.
	heading1 name: 'Heading 1'.
	heading1 centered.
	self makeAvailable: heading1.

	heading2 _ TextStyle withFont: dejaVu18 italic.
	heading2 name: 'Heading 2'.
	self makeAvailable: heading2.

	heading3 _ TextStyle withFont: dejaVu14.
	heading3 name: 'Heading 3'.
	self makeAvailable: heading3.

	emphasized _ TextStyle withFont: dejaVu10 bold.
	emphasized name: 'Emphasized'.
	self makeAvailable: emphasized.
	
	normal _ TextStyle withFont: dejaVu11.
	normal name: 'Normal'.
	normal justified.
	self makeAvailable: normal.! !


!Transcripter methodsFor: 'accessing' stamp: 'jmv 7/28/2009 15:58'!
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
		style: TextStyle default
		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! !

TextStyle class removeSelector: #defaultMarginTabsArray!
TextStyle class removeSelector: #new!
TextStyle removeSelector: #baseline!
TextStyle removeSelector: #baseline:!
TextStyle removeSelector: #clearIndents!
TextStyle removeSelector: #firstIndent!
TextStyle removeSelector: #firstIndent:!
TextStyle removeSelector: #leading!
TextStyle removeSelector: #leading:!
TextStyle removeSelector: #leftMarginTabAt:!
TextStyle removeSelector: #lineGrid!
TextStyle removeSelector: #marginTabAt:side:!
TextStyle removeSelector: #restIndent!
TextStyle removeSelector: #restIndent:!
TextStyle removeSelector: #rightIndent!
TextStyle removeSelector: #rightIndent:!
TextStyle removeSelector: #rightMarginTabAt:!
TextStyle removeSelector: #veryDeepCopyWith:!
!classDefinition: #TextStyle category: #'Graphics-Text'!
Object subclass: #TextStyle
	instanceVariableNames: 'name font alignment tabsArray'
	classVariableNames: 'AvailableTextStyles DefaultTextStyle'
	poolDictionaries: ''
	category: 'Graphics-Text'!

!TextStyle reorganize!
('accessing' alignment alignment: centered font font: initialLineGrid justified leftFlush name name: printOn: rightFlush)
('tabs and margins' nextTabXFrom:leftMargin:rightMargin: tabWidth)
!

TextMorph removeSelector: #beAllFont:!
TextMorph removeSelector: #reverseCurveDirection!
TextMorph removeSelector: #setCurveBaseline:!
TextMorph removeSelector: #textStyle!
TextMorph removeSelector: #xeqLinkText:withParameter:!
!classDefinition: #TextLine category: #'Morphic-Text Support'!
Object subclass: #TextLine
	instanceVariableNames: 'left right top bottom firstIndex lastIndex internalSpaces paddingWidth baseline'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Text Support'!
Text class removeSelector: #string:emphasis:!
Text removeSelector: #attributesAt:forStyle:!
Text removeSelector: #rangeOf:startingAt:forStyle:!
StrikeFont removeSelector: #lineGrid!
NewParagraph removeSelector: #adjustedFirstCharacterIndex!
NewParagraph removeSelector: #asParagraphForPostscript!
NewParagraph removeSelector: #fixLastWithHeight:!
NewParagraph removeSelector: #replaceFrom:to:with:displaying:!
CharacterBlockScanner removeSelector: #buildCharacterBlockIn:!
CharacterBlockScanner removeSelector: #characterBlockAtPoint:in:!
CharacterBlockScanner removeSelector: #characterBlockForIndex:in:!
CharacterBlockScanner removeSelector: #indentationLevel:!
!classDefinition: #CharacterBlockScanner category: #'Graphics-Text'!
CharacterScanner subclass: #CharacterBlockScanner
	instanceVariableNames: 'characterPoint characterIndex lastCharacter lastCharacterExtent lastSpaceOrTabExtent specialWidth'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Text'!
CharacterScanner removeSelector: #handleIndentation!
CharacterScanner removeSelector: #indentationLevel!
CharacterScanner removeSelector: #indentationLevel:!
CharacterScanner removeSelector: #initializeFromParagraph:clippedBy:!
!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'!
Canvas removeSelector: #paragraph2:bounds:color:!
AbstractFont removeSelector: #lineGrid!
AbstractFont removeSelector: #textStyle!
!classDefinition: #AbstractFont category: #'Graphics-Text'!
Object subclass: #AbstractFont
	instanceVariableNames: 'defaultTextStyle'
	classVariableNames: 'AvailableFonts DefaultFont'
	poolDictionaries: ''
	category: 'Graphics-Text'!
Smalltalk removeClassNamed: #CanvasCharacterScanner!
Smalltalk removeClassNamed: #TextIndent!
"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."
| oldPrefix newPrefix |
oldPrefix _ 'Morphic-Old-'.
newPrefix _ 'Morphic-'.
(Smalltalk organization categoriesMatching: oldPrefix, '*') do: [ :oldName |
	newName _ newPrefix, (oldName copyFrom: oldPrefix size + 1 to: oldName size).
	Smalltalk organization renameCategory: oldName toBe: newName ].
oldPrefix _ 'Morphic-Old'.
newPrefix _ 'Morphic-'.
(Smalltalk organization categoriesMatching: oldPrefix, '*') do: [ :oldName |
	newName _ newPrefix, (oldName copyFrom: oldPrefix size + 1 to: oldName size).
	Smalltalk organization renameCategory: oldName toBe: newName ].!

