'From Cuis 1.0 of 6 August 2009 [latest update: #258] on 19 August 2009 at 6:25:55 pm'!
!classDefinition: #PluggableTextMorph category: #'Morphic-Windows'!
ScrollPane subclass: #PluggableTextMorph
	instanceVariableNames: 'textMorph getTextSelector setTextSelector getSelectionSelector hasUnacceptedEdits askBeforeDiscardingEdits selectionInterval hasEditingConflicts editorClass styler unstyledAcceptText '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Windows'!

!PluggableTextMorph commentStamp: '<historical>' prior: 0!
Comment about Shout specifics:
Instances of me are usually created using my #on:text:accept:readSelection:menu: class method.

In order to colour the text, I use an instance of SHTextStylerST80, which I store in my 'styler' instance variable.

When my setText: method is called, I use my styler to ...
	a) optionally set all assignments to ansi or leftArrow. 
	b) Colour my text (immediately, if the text is less than 4096 chars in length, or in a backgroundProcess otherwise)

	When my text is changed, my hasUnacceptedEdits: method is called with true, and I ask my styler to re-colour my text. This is performed in a background process so that typing remains responsive regardless of the length of the text.

	Just before my styler is about to format/style the text, I send #stylerAboutToStyle:  to my model. This gives my model a chance to veto the styling (by answering false), or to initialize the styler with information it needs in order to parse the text correctly (e.g. the class to which a method belongs, or the workspace in which I am contained).

	My styler informs me that it has finished styling by triggering the #stylerStyled: and #stylerStyledInBackground: events which I handle. I then update the textAttributes of my text and refresh the display.
 
	My 'unstyledAcceptText' instance variable is used in conjunction with my #acceptTextInModel and #correctFrom:to:with: methods to ensure that when my text is modified during a method compilation (removing unused vars etc), I do not lose those changes.
	
!

!classDefinition: #SHParserST80 category: #'Shout-Parsing'!
Object subclass: #SHParserST80
	instanceVariableNames: 'classOrMetaClass source workspace arguments sourcePosition currentToken currentTokenFirst temporaries instanceVariables errorBlock currentTokenSourcePosition blockDepth bracketDepth ranges'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Shout-Parsing'!

!SHParserST80 commentStamp: 'tween 8/16/2004 15:44' prior: 0!
I am a Smalltalk method / expression parser.

Rather than creating an Abstract Syntax Tree, I create a sequence of SHRanges (in my 'ranges' instance variable), which represent the tokens within the String I am parsing.

I am used by a SHTextStylerST80 to parse method source strings.
I am able to parse incomplete / incorrect methods, and so can be used to parse methods that are being edited.

My 'source' instance variable should be set to the string to be parsed.

My 'classOrMetaClass' instance var must be set to the class or metaClass for the method source so that I can correctly resolve identifiers within the source. If this is nil , I parse the source as an expression (i.e. a doIt expression).

My 'workspace' instance variable can be set to a Workspace, so that I can resolve workspace variables.

My 'environment' instance variable is the global namespace (this is initialized to Smalltalk, but can be set to a different environment).

Example 1.
	ranges := SHParserST80 new
		classOrMetaClass: Object;
		source: 'testMethod ^self';
		parse;
		ranges
		
!

!classDefinition: #SHRange category: #'Shout-Parsing'!
Object subclass: #SHRange
	instanceVariableNames: 'start end type'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Shout-Parsing'!

!SHRange commentStamp: 'tween 8/16/2004 15:16' prior: 0!
I associate a type with a range of characters in a String
I have these instance variables...
	start - the one based index of the first character of the range within the String.
	end - the one based index of the last character  of the range within the String.
	type - a Symbol describing the type of the range
	
A sequence of instances of me are created by an instance of SHParserST80 which can then used by an instance of  SHTextStyler to style Text. !

!classDefinition: #SHTextStyler category: #'Shout-Styling'!
Object subclass: #SHTextStyler
	instanceVariableNames: 'sem backgroundProcess text monitor view stylingEnabled'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Shout-Styling'!

!SHTextStyler commentStamp: 'tween 8/27/2004 10:54' prior: 0!
I am an Abstract class.
Subclasses of me can create formatted, coloured, and styled copies of Text that is given to them.
They may perform their styling asynchronously, in a background process which I create and manage.

My public interface is...

	view: aViewOrMorph - set the view that will receive notifications when styling has completed.
	
	format: aText - modifies aText's string

	style: aText - modifies the TextAttributes of aText, but does not change the string, then sends #stylerStyled: to the view.

	styleInBackgroundProcess: aText - performs style: in a background process, then sends #stylerStylednBackground: to the view.

	styledTextFor: aText - answers a formatted and styled copy of aText

	unstyledTextFrom: aText - answers a copy of aText with all TextAttributes removed

Subclasses of me should re-implement...

	privateFormat: aText - answer a formatted version of aText; the String may be changed
	privateStyle: aText - modify the TextAttributes of aText; but do not change the String
	

	
	
!

!classDefinition: #SHTextStylerST80 category: #'Shout-Styling'!
SHTextStyler subclass: #SHTextStylerST80
	instanceVariableNames: 'classOrMetaClass workspace parser formatAssignments sourceMap processedSourceMap'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Shout-Styling'!

!SHTextStylerST80 commentStamp: 'tween 8/27/2004 10:55' prior: 0!
I style Smalltalk methods and expressions.

My 'styleTable' class instance var holds an array ofArrays which control how each token is styled/coloured. See my defaultStyleTable class method for its structure.
My styleTable can be changed by either modifying the defaultStyleTable class method and then executing SHTextStylerST80 initialize ; or by giving me a new styleTable through my #styleTable: class method.

My 'textAttributesByPixelSize' class instance var contains a dictionary of dictionaries.
	The key is a pixelSize and the value a Dictionary from token type Symbol to TextAttribute array.
	It is created/maintained automatically.
	
I also install these 3 preferences when my class initialize method is executed....
	#syntaxHighlightingAsYouType  - controls whether methods are styled in browsers
	#syntaxHighlightingAsYouTypeAnsiAssignment - controls whether assignments are formatted to be :=
	#syntaxHighlightingAsYouTypeLeftArrowAssignment - controls whether assignments are formatted to be _

I reimplement #unstyledTextFrom: so that TextActions are preserved in the unstyled text 
	
	
	
	
	 
	
!

!classDefinition: 'SHTextStylerST80 class' category: nil!
SHTextStylerST80 class
	instanceVariableNames: 'styleTable textAttributes'!

!CodeHolder methodsFor: '*Shout-Styling' stamp: 'jmv 8/19/2009 18:22'!
shoutAboutToStyle: aSHTextStyler
	"This is a notification that aSHTextStyler is about to re-style its text.
	The default is to answer false to veto the styling"
	"jmv-Changed.  The default is true."
	
	^true! !

!CodeHolder methodsFor: '*Shout-Styling' stamp: 'dp 6/28/2006 20:50'!
shoutIsModeStyleable
	"determine if Shout can style in the current mode"
	^ self showingSource or: [self showingPrettyPrint]! !


!Browser methodsFor: '*Shout-Styling' stamp: 'jmv 8/19/2009 15:37'!
shoutAboutToStyle: aSHTextStyler
	"This is a notification that aSHTextStyler is about to re-style its text.
	Set the classOrMetaClass in aSHTextStyler, so that identifiers
	will be resolved correctly.
	Answer true to allow styling to proceed, or false to veto the styling"
	| type |
	
	self shoutIsModeStyleable ifFalse: [^false].
	type := self editSelection.
	(#(newMessage editMessage editClass newClass) includes: type) ifFalse:[^false].
	aSHTextStyler classOrMetaClass: (type = #editClass ifFalse:[self selectedClassOrMetaClass]).
	^true! !


!ChangeSorter methodsFor: '*Shout-Styling' stamp: 'jmv 8/19/2009 15:37'!
shoutAboutToStyle: aSHTextStyler
	"This is a notification that aSHTextStyler is about to re-style its text.
	Set the classOrMetaClass in aSHTextStyler, so that identifiers
	will be resolved correctly.
	Answer true to allow styling to proceed, or false to veto the styling"

	self shoutIsModeStyleable ifFalse: [^false].
	self currentSelector ifNil: [^false].
	aSHTextStyler classOrMetaClass: self selectedClassOrMetaClass.
	^true! !


!Debugger methodsFor: '*Shout-Styling' stamp: 'jmv 8/19/2009 15:37'!
shoutAboutToStyle: aSHTextStyler
	"This is a notification that aSHTextStyler is about to re-style its text.
	Set the classOrMetaClass in aSHTextStyler, so that identifiers
	will be resolved correctly.
	Answer true to allow styling to proceed, or false to veto the styling"
	
	self shoutIsModeStyleable ifFalse: [^false].
	aSHTextStyler 
		classOrMetaClass: self selectedClassOrMetaClass;
		sourceMap: (sourceMap ifNil:["build the sourceMap now by calling pcRange"self pcRange. sourceMap]).
	^true! !


!Editor methodsFor: 'typing/selecting keys' stamp: 'jmv 8/16/2009 17:47'!
backspace: characterStream 
	"Backspace over the last character."

	| startIndex |
	sensor leftShiftDown ifTrue: [^ self backWord: characterStream].
	characterStream isEmpty
		ifTrue: [
			startIndex _ self markIndex +
				(self hasCaret ifTrue: [0] ifFalse: [1]).
			[sensor keyboardPressed and:
			[sensor keyboardPeek asciiValue = 8]] whileTrue: [
				"process multiple backspaces"
				sensor keyboard.
				startIndex _ 1 max: startIndex - 1.
			].
			self backTo: startIndex]
		ifFalse:
			[sensor keyboard.
			characterStream skip: -1].
	^false! !


!FileContentsBrowser methodsFor: '*Shout-Styling' stamp: 'jmv 8/19/2009 15:37'!
shoutAboutToStyle: aSHTextStyler
	"This is a notification that aSHTextStyler is about to re-style its text.
	Set the classOrMetaClass in aSHTextStyler, so that identifiers
	will be resolved correctly.
	Answer true to allow styling to proceed, or false to veto the styling"

	self shoutIsModeStyleable ifFalse: [^false].
	aSHTextStyler classOrMetaClass: self selectedClassOrMetaClass.
	^true! !


!MessageSet methodsFor: '*Shout-Styling' stamp: 'jmv 8/19/2009 15:37'!
shoutAboutToStyle: aSHTextStyler
	"This is a notification that aSHTextStyler is about to re-style its text.
	Set the classOrMetaClass in aSHTextStyler, so that identifiers
	will be resolved correctly.
	Answer true to allow styling to proceed, or false to veto the styling"
	
	self shoutIsModeStyleable ifFalse: [^false].
	aSHTextStyler classOrMetaClass: self selectedClassOrMetaClass.
	^true! !


!PluggableTextMorph methodsFor: 'interactive error protocol' stamp: 'jmv 8/18/2009 22:42'!
correctFrom: start to: stop with: aString
	unstyledAcceptText ifNotNil: [ unstyledAcceptText replaceFrom: start to: stop with: aString ].
	^ self handleEdit: [textMorph editor correctFrom: start to: stop with: aString]! !

!PluggableTextMorph methodsFor: 'model access' stamp: 'jmv 8/18/2009 22:50'!
basicSetText: aText
	scrollBar setValue: 0.0.
	textMorph 
		ifNil: [
			textMorph _ TextMorphForEditView new
				contents: aText wrappedTo: self viewableWidth-6.
			textMorph setEditView: self.
			scroller addMorph: textMorph]
		ifNotNil: [textMorph newContents: aText].
	self hasUnacceptedEdits: false.
	self setScrollDeltas.! !

!PluggableTextMorph methodsFor: 'model access' stamp: 'jmv 8/18/2009 22:51'!
setText: aText
	self okToStyle ifFalse: [ ^self basicSetText: aText ].
	self basicSetText: (styler format: aText asText).
	aText size < 4096
		ifTrue: [ styler style: textMorph contents ]
		ifFalse: [ styler styleInBackgroundProcess:  textMorph contents ]! !

!PluggableTextMorph methodsFor: 'unaccepted edits' stamp: 'jmv 8/18/2009 22:44'!
hasUnacceptedEdits: aBoolean
	"Set the hasUnacceptedEdits flag to the given value. "
	aBoolean == hasUnacceptedEdits ifFalse:
		[hasUnacceptedEdits _ aBoolean.
		self changed].
	aBoolean ifFalse: [hasEditingConflicts _ false].

	"shout:  re-style the text iff aBoolean is true"
	(aBoolean and: [self okToStyle])
		ifTrue: [ styler styleInBackgroundProcess: textMorph contents ]! !

!PluggableTextMorph methodsFor: 'shout' stamp: 'jmv 8/19/2009 18:18'!
okToStyle
	styler ifNil: [ ^false ].
	^model shoutAboutToStyle: styler
! !

!PluggableTextMorph methodsFor: 'shout' stamp: 'jmv 8/18/2009 22:47'!
styler: anObject
	
	styler := anObject! !

!PluggableTextMorph methodsFor: 'shout' stamp: 'jmv 8/19/2009 17:49'!
stylerStyled: styledCopyOfText

	textMorph contents setRuns: styledCopyOfText runs .
	"textMorph paragraph recomposeFrom: 1 to: textMorph contents size delta: 0."     "caused chars to appear in wrong order esp. in demo mode. remove this line when sure it is fixed"
	textMorph updateFromParagraph.
	selectionInterval 
		ifNotNil: [
			textMorph editor
				selectInvisiblyFrom: selectionInterval first to: selectionInterval last;
				storeSelectionInParagraph;
				setEmphasisHere].
	textMorph editor blinkParen.
	self scrollSelectionIntoView! !

!PluggableTextMorph methodsFor: 'shout' stamp: 'jmv 8/19/2009 15:38'!
stylerStyledInBackground: styledCopyOfText 
	"It is possible that the text string has changed since the styling began. Disregard the styles if styledCopyOfText's string differs with the current textMorph contents string"
	
	textMorph contents string = styledCopyOfText string
		ifTrue: [self stylerStyled: styledCopyOfText]! !


!PluggableTextMorph class methodsFor: 'as yet unclassified' stamp: 'jmv 8/19/2009 18:18'!
on: anObject editorClass: anEditorClass text: getTextSel accept: setTextSel readSelection: getSelectionSel menu: getMenuSel

	|styler answer |
	answer _ self new.
	(Preferences syntaxHighlightingAsYouType 
			and: [ anObject respondsTo: #shoutAboutToStyle:]) ifTrue: [
		styler _ SHTextStylerST80 new.
		styler view: answer.
		answer styler: styler ].
	answer
		on: anObject
		editorClass: anEditorClass
		text: getTextSel
		accept: setTextSel
		readSelection: getSelectionSel
		menu: getMenuSel.
	^answer! !


!Preferences class methodsFor: 'standard queries'!
syntaxHighlightingAsYouType
	^ self
		valueOfFlag: #syntaxHighlightingAsYouType
		ifAbsent: [true]! !


!SHParserST80 methodsFor: 'accessing' stamp: 'tween 4/13/2004 20:20'!
classOrMetaClass: aClass
    classOrMetaClass := aClass! !

!SHParserST80 methodsFor: 'accessing' stamp: 'tween 4/17/2004 22:21'!
source
	^source! !

!SHParserST80 methodsFor: 'accessing' stamp: 'tween 4/27/2004 18:59'!
source: aString
    source := aString! !

!SHParserST80 methodsFor: 'accessing' stamp: 'tween 4/15/2004 13:18'!
workspace: aWorkspace
    workspace := aWorkspace! !

!SHParserST80 methodsFor: 'scan' stamp: 'tween 4/28/2004 09:42'!
currentChar
	^source at: sourcePosition ifAbsent: [nil]! !

!SHParserST80 methodsFor: 'scan' stamp: 'tween 4/28/2004 09:42'!
nextChar
	sourcePosition := sourcePosition + 1.
	^source at: sourcePosition ifAbsent: [$ ]! !

!SHParserST80 methodsFor: 'scan' stamp: 'tween 4/28/2004 09:42'!
peekChar
	^source at: sourcePosition + 1 ifAbsent: [$ ]! !

!SHParserST80 methodsFor: 'scan' stamp: 'tween 2/17/2007 14:49'!
scanBinary
	| c d |
	c := self currentChar.
	currentTokenSourcePosition := sourcePosition.
	currentToken := c asString.
	d := self nextChar.
	((self isSelectorCharacter: c) or: [c == $: or: [c == $-]]) ifFalse: [^currentToken].
	(c == $: and: [d == $=]) 
		ifTrue: [" := assignment"
			currentToken := currentToken , d asString.
			self nextChar.
			^currentToken].
	c == $| ifTrue:["| cannot precede a longer token" ^currentToken].
	[self isSelectorCharacter: d] 
		whileTrue: [
			currentToken := currentToken , d asString.
			d := self nextChar].
	^currentToken! !

!SHParserST80 methodsFor: 'scan' stamp: 'tween 2/17/2007 14:49'!
scanComment
	| c s e |
	s := sourcePosition.
	
	[sourcePosition := sourcePosition + 1.
	(c := self currentChar) 
		ifNil: [
			self rangeType: #unfinishedComment start: s end: source size.
			^self error	": 'unfinished comment'"].
	c == $"] 
		whileFalse: [].
	e := sourcePosition.
	s < e ifTrue: [self rangeType: #comment start: s end: e].
	self nextChar.
	self scanWhitespace! !

!SHParserST80 methodsFor: 'scan' stamp: 'tween 2/17/2007 14:49'!
scanIdentifier
	| c start |
	start := sourcePosition.
	[(c := self nextChar) isAlphaNumeric] whileTrue: [].
	(c == $: and: [(self isSelectorCharacter: self peekChar) not]) 
		ifTrue: [self nextChar].
	currentToken := source copyFrom: start to: sourcePosition - 1.
	currentTokenSourcePosition := start! !

!SHParserST80 methodsFor: 'scan' stamp: 'tween 4/28/2004 14:14'!
scanNext
	self scanWhitespace.
	currentTokenFirst := self currentChar.
	currentTokenFirst isNil 
		ifTrue: [" end of input "
			currentTokenFirst := $ .
			currentTokenSourcePosition := nil.
			currentToken := nil.
			^nil].
	currentTokenFirst isDigit ifTrue: [^self scanNumber].
	currentTokenFirst isLetter ifTrue: [^self scanIdentifier].
	^self scanBinary! !

!SHParserST80 methodsFor: 'scan' stamp: 'tween 3/4/2007 13:15'!
scanNumber
	| start c nc base |
	start := sourcePosition.
	self skipDigits.
	c := self currentChar.
	c == $r 
		ifTrue: [
			base := Integer readFrom: (ReadStream on: (source copyFrom: start to: sourcePosition - 1)).
			self peekChar == $- ifTrue:[self nextChar].
			self skipBigDigits: base.
			c := self currentChar.
			c == $. 
				ifTrue: [
					(self isBigDigit: self nextChar base: base) 
						ifFalse: [sourcePosition := sourcePosition - 1]
						ifTrue: [self skipBigDigits: base]].
			c := self currentChar.
			('deq'includes: c) 
				ifTrue: [
					((nc := self nextChar) isDigit or: [nc == $- and:[self peekChar isDigit]]) 
						ifFalse: [sourcePosition := sourcePosition - 1]
						ifTrue: [self skipDigits]].
			c == $s 
				ifTrue: [
					self nextChar isDigit 
						ifFalse: [sourcePosition := sourcePosition - 1]
						ifTrue: [self skipDigits]].
			currentToken := source copyFrom: start to: sourcePosition - 1.
			^currentTokenSourcePosition := start].
	c == $s 
		ifTrue: [
			self nextChar isDigit 
				ifFalse: [sourcePosition := sourcePosition - 1]
				ifTrue: [self skipDigits.].
			currentToken := source copyFrom: start to: sourcePosition - 1.
			^currentTokenSourcePosition := start].
	c == $. 
		ifTrue: [
			self nextChar isDigit 
				ifFalse: [
					sourcePosition := sourcePosition - 1.
					currentToken := source copyFrom: start to: sourcePosition - 1.
					^currentTokenSourcePosition := start]
				ifTrue: [self skipDigits]].
	c := self currentChar.
	('deq' includes: c) 
		ifTrue: [
			((nc := self nextChar) isDigit or: [nc == $-  and:[self peekChar isDigit]]) 
				ifFalse: [sourcePosition := sourcePosition - 1]
				ifTrue: [self skipDigits]].
	c == $s 
		ifTrue: [
			self nextChar isDigit 
				ifFalse: [sourcePosition := sourcePosition - 1]
				ifTrue: [self skipDigits]].
	currentToken := source copyFrom: start to: sourcePosition - 1.
	^currentTokenSourcePosition := start! !

!SHParserST80 methodsFor: 'scan' stamp: 'tween 4/28/2004 10:06'!
scanPast: rangeType 
	"record rangeType for current token .
	record argument and temp declarations.
	scan and answer the next token"
	rangeType = #blockPatternArg ifTrue: [self pushArgument: currentToken].
	rangeType = #blockPatternTempVar ifTrue: [self pushTemporary: currentToken].
	rangeType = #patternArg ifTrue: [self pushArgument: currentToken].
	rangeType = #patternTempVar ifTrue: [self pushTemporary: currentToken].
	^self
		rangeType: rangeType;
		scanNext! !

!SHParserST80 methodsFor: 'scan' stamp: 'tween 4/28/2004 14:17'!
scanPast: rangeType level: level
	"first level adds no suffix to the rangeType.
	Suffix from 1 to 7 added in cycles , ((level-2) mod(7) + 1)"
	| cycle typePlusCycle |
	
	cycle := level <= 1 
		ifTrue: [0]
		ifFalse:[ ((level - 2) \\ 7) + 1].
	typePlusCycle := cycle = 0 
		ifTrue:[rangeType]
		ifFalse:[(rangeType, cycle asString) asSymbol].
	^self scanPast: typePlusCycle
! !

!SHParserST80 methodsFor: 'scan' stamp: 'tween 4/28/2004 09:56'!
scanPast: rangeType start: startInteger end: endInteger
	"record rangeType for current token from startInteger to endInteger,
	 and scanNext token"

	^self 
		rangeType: rangeType start: startInteger end: endInteger;
		scanNext
	
! !

!SHParserST80 methodsFor: 'scan' stamp: 'tween 2/17/2007 14:51'!
scanWhitespace
	| c |
	
	[c := self currentChar.
	c notNil and: [c isSeparator]] 
		whileTrue: [sourcePosition := sourcePosition + 1].
	c == $" ifTrue: [self scanComment]! !

!SHParserST80 methodsFor: 'scan' stamp: 'tween 8/6/2005 13:20'!
skipBigDigits: baseInteger
	[self isBigDigit: self nextChar base: baseInteger] 
		whileTrue: []
! !

!SHParserST80 methodsFor: 'scan' stamp: 'tween 4/28/2004 14:57'!
skipDigits
	[self nextChar isDigit] 
		whileTrue: []! !

!SHParserST80 methodsFor: 'parse support' stamp: 'tween 4/28/2004 09:48'!
enterBlock
	blockDepth := blockDepth + 1.
	bracketDepth := bracketDepth + 1! !

!SHParserST80 methodsFor: 'parse support' stamp: 'tween 4/28/2004 10:08'!
initializeInstanceVariables
	instanceVariables := classOrMetaClass notNil 
		ifTrue: [classOrMetaClass allInstVarNames asArray]
		ifFalse: [Set new]! !

!SHParserST80 methodsFor: 'parse support' stamp: 'tween 4/28/2004 09:48'!
leaveBlock
	arguments removeKey: blockDepth ifAbsent: [].
	temporaries removeKey: blockDepth ifAbsent: [].
	blockDepth := blockDepth - 1.
	bracketDepth := bracketDepth - 1! !

!SHParserST80 methodsFor: 'parse support' stamp: 'tween 4/28/2004 10:03'!
pushArgument: aString 
	(arguments at: blockDepth ifAbsentPut: [OrderedCollection new: 10]) 
		add: aString! !

!SHParserST80 methodsFor: 'parse support' stamp: 'tween 4/28/2004 10:05'!
pushTemporary: aString 
	(temporaries at: blockDepth ifAbsentPut: [OrderedCollection new: 10]) 
		add: aString! !

!SHParserST80 methodsFor: 'error handling' stamp: 'tween 4/28/2004 10:16'!
error
	self 
		rangeType: #excessCode
		start: (ranges isEmpty ifTrue: [1] ifFalse: [ranges last end + 1])
		end: source size.
	errorBlock value! !

!SHParserST80 methodsFor: 'error handling' stamp: 'tween 8/7/2005 14:31'!
failUnless: aBoolean
	aBoolean ifFalse:[self error]
! !

!SHParserST80 methodsFor: 'error handling' stamp: 'tween 8/7/2005 14:31'!
failWhen: aBoolean
	aBoolean ifTrue:[self error]! !

!SHParserST80 methodsFor: 'token testing' stamp: 'tween 4/28/2004 09:43'!
isAnsiAssignment
	^currentToken = ':='! !

!SHParserST80 methodsFor: 'token testing' stamp: 'tween 4/28/2004 09:43'!
isAssignment
	^currentToken = ':=' or: [currentToken = '_']! !

!SHParserST80 methodsFor: 'token testing' stamp: 'tween 2/17/2007 14:31'!
isBinary
	(currentToken isNil or: [self isName or: [self isKeyword]]) 
		ifTrue: [^false].
	1 to: currentToken size do: [:i | | c |
		c := currentToken at: i.
		((self isSelectorCharacter: c) or: [i = 1 and: [c == $-]]) 
			ifFalse: [^false]].
	^true! !

!SHParserST80 methodsFor: 'token testing' stamp: 'tween 2/17/2007 14:32'!
isKeyword
	^currentTokenFirst isLetter and: [currentToken last == $:]! !

!SHParserST80 methodsFor: 'token testing' stamp: 'tween 4/28/2004 09:44'!
isName
	^currentTokenFirst isLetter and: [currentToken last isAlphaNumeric]! !

!SHParserST80 methodsFor: 'token testing' stamp: 'tween 4/28/2004 09:43'!
isTokenExternalFunctionCallingConvention
	| descriptorClass |
	descriptorClass := Smalltalk at: #ExternalFunction ifAbsent: [nil].
	descriptorClass == nil ifTrue: [^false].
	^(descriptorClass callingConventionFor: currentToken) notNil! !

!SHParserST80 methodsFor: 'character testing' stamp: 'kwl 7/4/2006 06:54'!
isBigDigit: aCharacter base: anInteger
    "Answer true if aCharacter is a digit or a capital
    letter appropriate for base anInteger"
	| digitValue |
	
	digitValue := aCharacter digitValue.
	^digitValue >= 0 and:[digitValue < anInteger]! !

!SHParserST80 methodsFor: 'character testing' stamp: 'tween 2/17/2007 14:37'!
isSelectorCharacter: aCharacter

	aCharacter isAlphaNumeric ifTrue: [^false].
	aCharacter isSeparator ifTrue:[^false].
	"$- is specified here as NOT being a selector char, but it can appear as the 
	first char in a binary selector. That case is handled specially elsewhere"
	('"#$'':().;[]{}^_-'  includes: aCharacter) 
		ifTrue:[^false].
	aCharacter asciiValue = 30 ifTrue: [^false "the doIt char"].
	aCharacter asciiValue = 0 ifTrue: [^false].
	"Any other char is ok as a binary selector char."
	^true
! !

!SHParserST80 methodsFor: 'identifier testing' stamp: 'tween 5/7/2004 06:24'!
isBlockArgName: aString 
	"Answer true if aString is the name of a block argument, false otherwise"
	| temp arg |
	blockDepth to: 1 by: -1 do: [:level | 
		arg := (arguments at: level ifAbsent: [#()]) includes: aString.
		arg ifTrue: [^true].
		temp := (temporaries at: level ifAbsent: [#()]) includes: aString.
		temp ifTrue: [^false]].
	^false! !

!SHParserST80 methodsFor: 'identifier testing' stamp: 'tween 5/7/2004 06:24'!
isBlockTempName: aString 
	"Answer true if aString is the name of a block temporary. false otherwise"

	| temp arg |
	blockDepth to: 1 by: -1 do: [:level | 
		arg := (arguments at: level ifAbsent: [#()]) includes: aString.
		arg ifTrue: [^false].
		temp := (temporaries at: level ifAbsent: [#()]) includes: aString.
		temp ifTrue: [^true]].
	^false! !

!SHParserST80 methodsFor: 'identifier testing' stamp: 'tween 5/7/2004 06:37'!
isIncompleteBlockArgName: aString 
	"Answer true if aString is the start of the name of a block argument, false otherwise"
	|  arg |
	blockDepth to: 1 by: -1 do: [:level | 
		arg := (arguments at: level ifAbsent: [#()]) anySatisfy: [:each | each beginsWith: aString].
		arg ifTrue: [^true]].
	^false! !

!SHParserST80 methodsFor: 'identifier testing' stamp: 'tween 5/7/2004 06:37'!
isIncompleteBlockTempName: aString 
	"Answer true if aString is the start of the name of a block temporary. false otherwise"

	| temp  |
	blockDepth to: 1 by: -1 do: [:level | 
		temp := (temporaries at: level ifAbsent: [#()]) anySatisfy: [:each | each beginsWith: aString].
		temp ifTrue: [^true]].
	^false! !

!SHParserST80 methodsFor: 'identifier testing' stamp: 'tween 5/7/2004 06:38'!
isIncompleteMethodArgName: aString 
	"Answer true if aString is the start of the name of a method argument, false otherwise.
    Does not check whether aString is also a blockArgName"

	^(arguments at: 0 ifAbsent: [#()]) anySatisfy: [:each | each beginsWith: aString]! !

!SHParserST80 methodsFor: 'identifier testing' stamp: 'tween 5/7/2004 06:39'!
isIncompleteMethodTempName: aString 
	"Answer true if aString is the start of then name of a method temporary, false otherwise."

	^(temporaries at: 0 ifAbsent: [#()]) anySatisfy: [:each | each beginsWith: aString]! !

!SHParserST80 methodsFor: 'identifier testing' stamp: 'tween 5/7/2004 06:26'!
isMethodArgName: aString 
	"Answer true if aString is the name of a method argument, false otherwise.
    Does not check whether aString is also a blockArgName"

	^(arguments at: 0 ifAbsent: [#()]) includes: aString! !

!SHParserST80 methodsFor: 'identifier testing' stamp: 'tween 5/7/2004 06:25'!
isMethodTempName: aString 
	"Answer true if aString is the name of a method temporary, false otherwise.
    Does not check whether aString is also a block temporary
    or argument"

	((arguments at: 0 ifAbsent: [#()]) includes: aString) ifTrue: [^false].
	^(temporaries at: 0 ifAbsent: [#()]) includes: aString! !

!SHParserST80 methodsFor: 'identifier testing' stamp: 'jmv 8/18/2009 23:09'!
resolve: aString 
	(#('self' 'super' 'true' 'false' 'nil' 'thisContext') includes: aString) 
		ifTrue: [^aString asSymbol].
	(self isBlockTempName: aString) ifTrue: [^#blockTempVar].
	(self isBlockArgName: aString) ifTrue: [^#blockArg].
	(self isMethodTempName: aString) ifTrue: [^#tempVar].
	(self isMethodArgName: aString) ifTrue: [^#methodArg].
	(instanceVariables includes: aString) ifTrue: [^#instVar].
	workspace 
		ifNotNil: [(workspace hasBindingOf: aString) ifTrue: [^#workspaceVar]].
	Symbol hasInterned: aString ifTrue: [:sym | 
		classOrMetaClass isBehavior 
			ifTrue: [
				classOrMetaClass theNonMetaClass withAllSuperclasses do: [:c | 
					(c classPool bindingOf: sym) ifNotNil: [^#classVar].
					c sharedPools do: [:p | (p bindingOf: sym) ifNotNil: [^#poolConstant]].
					(Smalltalk bindingOf: sym) ifNotNil: [^#globalVar]]]
			ifFalse: [(Smalltalk bindingOf: sym) ifNotNil: [^#globalVar]]].
	^self resolvePartial: aString! !

!SHParserST80 methodsFor: 'identifier testing' stamp: 'jmv 8/19/2009 17:45'!
resolvePartial: aString 
	"check if any identifier begins with aString"
	
	(#('self' 'super' 'true' 'false' 'nil' 'thisContext') anySatisfy: [:each | each beginsWith: aString]) 
		ifTrue: [^#incompleteIdentifier].
	(self isIncompleteBlockTempName: aString) ifTrue: [^#incompleteIdentifier].
	(self isIncompleteBlockArgName: aString) ifTrue: [^#incompleteIdentifier].
	(self isIncompleteMethodTempName: aString) ifTrue: [^#incompleteIdentifier].
	(self isIncompleteMethodArgName: aString) ifTrue: [^#incompleteIdentifier].
	(instanceVariables anySatisfy: [:each | each beginsWith: aString]) ifTrue: [^#incompleteIdentifier].
	workspace 
		ifNotNil: [(self has: workspace bindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]].
	classOrMetaClass isBehavior 
		ifTrue: [
			classOrMetaClass theNonMetaClass withAllSuperclasses do: [:c | 
				(self has: c classPool bindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier].
				c sharedPools do: [:p | (self has: p bindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]].
				(self has: Smalltalk bindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]]]
		ifFalse: [(self has: Smalltalk bindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]].
	^#undefinedIdentifier! !

!SHParserST80 methodsFor: 'identifier testing' stamp: 'jmv 8/19/2009 17:44'!
resolvePartialPragmaArgument: aString 
	"check if any valid pragma argument begins with aString"
	
	(#('true' 'false' 'nil') anySatisfy: [:each | each beginsWith: aString]) 
		ifTrue: [^#incompleteIdentifier].
	"should really check that a matching binding is for a Class?"
	classOrMetaClass isBehavior 
		ifTrue: [
			classOrMetaClass theNonMetaClass withAllSuperclasses do: [:c | 
				(self has: Smalltalk bindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]]]
		ifFalse: [(self has: Smalltalk bindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]].
	^#undefinedIdentifier! !

!SHParserST80 methodsFor: 'identifier testing' stamp: 'jmv 8/18/2009 23:09'!
resolvePragmaArgument: aString 
	(#('true' 'false' 'nil') includes: aString) ifTrue: [^aString asSymbol].
	"should really check that global is a class?"
	Symbol hasInterned: aString ifTrue: [:sym | 
		classOrMetaClass isBehavior 
			ifTrue: [
				classOrMetaClass theNonMetaClass withAllSuperclasses do: [:c | 
					(Smalltalk bindingOf: sym) ifNotNil: [^#globalVar]]]
			ifFalse: [(Smalltalk bindingOf: sym) ifNotNil: [^#globalVar]]].
	^self resolvePartialPragmaArgument: aString! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 4/17/2004 11:29'!
parse
    "Parse the receiver's text as a Smalltalk method"

    ^self parse: (classOrMetaClass notNil) ! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 7/8/2006 11:08'!
parse: isAMethod 
	"Parse the receiver's text. If isAMethod is true
    then treat text as a method, if false as an
    expression with no message pattern"

	self initializeInstanceVariables.
	sourcePosition := 1.
	arguments := Dictionary new.
	temporaries := Dictionary new.
	blockDepth := bracketDepth := 0.
	ranges isNil 
		ifTrue: [ranges := OrderedCollection new: 100]
		ifFalse: [ranges reset].
	errorBlock := [^false].
	[self scanNext.
	isAMethod 
		ifTrue: [
			self parseMessagePattern.
			self parsePragmaSequence].
	self parseMethodTemporaries.
	isAMethod ifTrue: [self parsePragmaSequence].
	self parseStatementList.
	currentToken ifNotNil: [self error]]
		ensure:[errorBlock := nil].
	^true! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 2/17/2007 14:38'!
parseArray
	[currentTokenFirst == $)] whileFalse: [self parseLiteralArrayElement].
	self scanPast: #arrayEnd! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 5/7/2004 09:31'!
parseBinary 
	| binary type |
	self parseUnary.
	[self isBinary] 
		whileTrue: [
			binary := currentToken.
			type := #binary.
			(binary isEmpty or:[Symbol hasInterned: binary ifTrue: [:sym | ]])
				ifFalse:[
					type := (Symbol thatStartsCaseSensitive: binary skipping: nil) isNil
						ifTrue: [#undefinedBinary]
						ifFalse:[#incompleteBinary]].	
			self scanPast: type. 	
			self parseTerm.
            	self parseUnary]
! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 8/7/2005 14:26'!
parseBinaryMessagePattern   

   	self scanPast:  #patternBinary. 
	self failUnless: self isName.
	self scanPast: #patternArg.

! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 2/17/2007 14:39'!
parseBlock
	self enterBlock.
	self scanPast: #blockStart level: bracketDepth.
	currentTokenFirst == $: ifTrue: [self parseBlockArguments].
	currentTokenFirst == $| ifTrue: [self parseBlockTemporaries].
	self parseStatementList.
	self failUnless: currentTokenFirst == $].
	self scanPast: #blockEnd level: bracketDepth.
	self leaveBlock! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 2/17/2007 14:39'!
parseBlockArguments
	[currentTokenFirst == $:] 
		whileTrue: [
			self scanPast: #blockArgColon.
			self failUnless: self isName.
			self scanPast: #blockPatternArg].
	currentTokenFirst == $| 
		ifTrue: [^self scanPast: #blockArgsBar]! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 2/17/2007 14:42'!
parseBlockTemporaries
	currentTokenFirst == $| 
		ifTrue: [
			self scanPast: #blockTempBar.
			[self isName] 
				whileTrue: [self scanPast: #blockPatternTempVar].
			self failUnless: currentToken = '|'.
			self scanPast: #blockTempBar]! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 2/17/2007 14:40'!
parseBraceArray
	self parseStatementListForBraceArray.
	self failUnless: currentTokenFirst == $}.
	self scanPast: #rightBrace! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 2/17/2007 14:40'!
parseCascade
	self parseKeyword.
	[currentTokenFirst == $;] 
		whileTrue: [
			self scanPast: #cascadeSeparator.
			self parseKeyword]! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 4/28/2004 14:28'!
parseCharSymbol
	| s e |
	s := sourcePosition - 1.
	e := sourcePosition.
	self nextChar.
	self scanPast: #symbol start: s end: e! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 4/28/2004 13:51'!
parseExpression
	| assignType |
	self isName 
		ifTrue: [
			self scanPast: (self resolve: currentToken).
			self isAssignment 
				ifTrue: [
					assignType := self isAnsiAssignment 
						ifTrue: [#ansiAssignment]
						ifFalse: [#assignment].
					self scanPast: assignType.
					self parseExpression]
				ifFalse: [self parseCascade]]
		ifFalse: [
			self parseTerm.
			self parseCascade]! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 2/17/2007 14:41'!
parseExternalCall
	self scanNext.
	self scanPast: #externalCallType.
	currentToken = '*' 
		ifTrue: [self scanPast: #externalCallTypePointerIndicator].
	currentTokenFirst isDigit 
		ifTrue: [self scanPast: #integer]
		ifFalse: 	[
			self failUnless: currentTokenFirst == $'.
			self parseString].
	self failUnless: currentTokenFirst == $(.
	self scanPast: #leftParenthesis.
	[currentTokenFirst ~~ $)] 
		whileTrue: [
			self scanPast: #externalCallType.
			currentToken = '*' 
				ifTrue: [self scanPast: #externalCallTypePointerIndicator]].
	self scanPast: #rightParenthesis.
	currentToken = 'module:' 
		ifTrue: [
			self scanPast: #module.
			self failUnless: currentTokenFirst == $'.
			self parseString].
	self failUnless: currentToken = '>'.
	self scanPast: #primitiveOrExternalCallEnd! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 5/7/2004 09:26'!
parseKeyword 
    | keyword rangeIndices type |
    self parseBinary.
	keyword := ''.
	rangeIndices := #().
	[
    		[self isKeyword]
        		whileTrue: [
				keyword := keyword, currentToken. 
				self rangeType: #keyword.
				"remember where this keyword token is in ranges"
				rangeIndices := rangeIndices copyWith: ranges size.
				self scanNext.
				self parseTerm.
				self parseBinary ]
	] ensure: [
		"do this in an ensure so that it happens even if the errorBlock evaluates before getting here"
		"patch up the keyword tokens, so that incomplete and undefined ones look different"
		(keyword isEmpty or:[Symbol hasInterned: keyword ifTrue: [:sym | ]])
			ifFalse:[
				type := (Symbol thatStartsCaseSensitive: keyword skipping: nil) isNil
					ifTrue: [#undefinedKeyword]
					ifFalse:[#incompleteKeyword].
				rangeIndices do: [:i | (ranges at: i) type: type]]]! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 8/7/2005 14:27'!
parseKeywordMessagePattern   

	[self isKeyword]
		whileTrue: [ 
			self scanPast:  #patternKeyword. 
			self failUnless: self isName.
			self scanPast: #patternArg]

! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 2/17/2007 14:43'!
parseLiteral: inArray 
	currentTokenFirst == $$ 
		ifTrue: [
			| pos |
			self failWhen: self currentChar isNil.
			self rangeType: #'$'.
			pos := currentTokenSourcePosition + 1.
			self nextChar.
			^self scanPast: #character start: pos end: pos].
	currentTokenFirst isDigit 
		ifTrue: [
			"do not parse the number, can be time consuming"
			^self scanPast: #number].
	currentToken = '-' 
		ifTrue: [
			| c |
			c := self currentChar.
			(inArray and: [c isNil or: [c isDigit not]]) 
				ifTrue: [
					"single - can be a symbol in an Array"
					^self scanPast: #symbol].
			self scanPast: #-.
			self failWhen: currentToken isNil.
			"token isNil ifTrue: [self error: 'Unexpected End Of Input']."
			"do not parse the number, can be time consuming"
			^self scanPast: #number].
	currentTokenFirst == $' ifTrue: [^self parseString].
	currentTokenFirst == $# ifTrue: [^self parseSymbol].
	(inArray and: [currentToken notNil]) ifTrue: [^self scanPast: #symbol].
	self failWhen: currentTokenFirst == $. .
	self error	": 'argument missing'"! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 2/17/2007 14:43'!
parseLiteralArrayElement
	currentTokenFirst isLetter 
		ifTrue: [
			| type |
			type := (#('true' 'false' 'nil') includes: currentToken) 
				ifTrue: [currentToken asSymbol]
				ifFalse: [#symbol].
			^self scanPast: type].
	currentTokenFirst == $( 
		ifTrue: [
			self scanPast: #arrayStart.
			^self parseArray].
	^self parseLiteral: true! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 8/7/2005 14:28'!
parseMessagePattern   

	self isName 
		ifTrue: [self parseUnaryMessagePattern]
		ifFalse: [
			self isBinary
				ifTrue:[self parseBinaryMessagePattern]
				ifFalse:[
					self failUnless: self isKeyword.
					self parseKeywordMessagePattern]]! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 2/17/2007 14:44'!
parseMethodTemporaries
	currentTokenFirst == $| 
		ifTrue: [
			self scanPast: #methodTempBar.
			[self isName] 
				whileTrue: [self scanPast: #patternTempVar].
			self failUnless: currentToken = '|'.
			self scanPast: #methodTempBar]! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 12/29/2006 11:13'!
parsePragmaBinary

	self scanPast: #pragmaBinary.
	self isName
		ifTrue:[self scanPast: (self resolvePragmaArgument: currentToken)] 
		ifFalse:[	self parseLiteral: false].
	self failUnless: currentToken = '>'.
	self scanPast: #primitiveOrExternalCallEnd! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 7/2/2006 12:59'!
parsePragmaKeyword

	[self isKeyword]
		whileTrue:[
			self scanPast: #pragmaKeyword.
			self isName
				ifTrue:[self scanPast: (self resolvePragmaArgument: currentToken)] 
				ifFalse:[	self parseLiteral: false]].
	self failUnless: currentToken = '>'.
	self scanPast: #primitiveOrExternalCallEnd! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 12/29/2006 11:11'!
parsePragmaSequence
	[currentToken = '<' ]
		whileTrue:[
			self scanPast: #primitiveOrExternalCallStart.
			currentToken = 'primitive:' 
				ifTrue: [
					self rangeType: #primitive.
					self parsePrimitive]
				ifFalse:[
					self isTokenExternalFunctionCallingConvention 
						ifTrue: [
							self rangeType: #externalFunctionCallingConvention.
							self parseExternalCall]
						ifFalse:[
							self isName
								ifTrue:[
									self scanPast: #pragmaUnary.
									self failUnless: currentToken = '>'.
									self scanPast: #primitiveOrExternalCallEnd]
								ifFalse:[
									self isKeyword
										ifTrue:[
											self parsePragmaKeyword]
										ifFalse:[
											self isBinary
												ifTrue:[self parsePragmaBinary]
												ifFalse:[	self error	": 'Invalid External Function Calling convention'" ]]]]]]! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 2/17/2007 15:10'!
parsePrimitive
	self scanNext.
	currentTokenFirst isDigit 
		ifTrue: [self scanPast: #integer]
		ifFalse: [
			self failUnless: currentTokenFirst == $'.
			self parseString.
			currentToken = 'module:' 
				ifTrue: [
					self scanPast: #module.
					self failUnless: currentTokenFirst == $'.
					self parseString]].
	self failUnless: currentToken = '>'.
	self scanPast: #primitiveOrExternalCallEnd! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 2/17/2007 14:44'!
parseStatement
	currentTokenFirst == $^ ifTrue: [self scanPast: #return].
	self parseExpression! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 2/17/2007 14:45'!
parseStatementList
	
	[[currentTokenFirst == $.] whileTrue: [self scanPast: #statementSeparator].
	(currentToken notNil and: [currentTokenFirst ~~ $]]) 
		ifTrue: [self parseStatement].
	currentTokenFirst == $.] 
			whileTrue: [self scanPast: #statementSeparator]! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 2/17/2007 14:45'!
parseStatementListForBraceArray
	"same as parseStatementList, but does not allow empty statements e.g {...$a...}.
	A single terminating . IS allowed e.g. {$a.} "

	
	[currentTokenFirst ~~ $} ifTrue: [self parseStatement].
	currentTokenFirst == $.] 
		whileTrue: [self scanPast: #statementSeparator]! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 2/17/2007 14:46'!
parseString
	| first c answer last |
	first := sourcePosition.
	answer := ''.
	
	[(c := self currentChar) isNil 
		ifTrue: [
			self rangeType: #unfinishedString start: first - 1 end: source size.
			self error	": 'unfinished string'"].
	(c ~~ $' 	
		ifTrue: [answer := answer copyWith: c. true] 
		ifFalse: [false]
	) or: [
		self peekChar == $' 
			ifTrue: [
				sourcePosition := sourcePosition + 1.
				answer := answer copyWith: $'.
				true]
			ifFalse: [false]]
	] whileTrue: [sourcePosition := sourcePosition + 1].
	last := sourcePosition.
	self nextChar.
	self scanPast: #string start: first - 1 end: last.
	^answer! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 2/17/2007 14:46'!
parseSymbol
	| c |
	currentToken = '#' 
		ifTrue: [
			"if token is just the #, then scan whitespace and comments
			and then process the next character.
			Squeak allows space between the # and the start of the symbol 
			e.g. # (),  #  a, #  'sym' "
			self rangeType: #symbol.
			self scanWhitespace].
	c := self currentChar.
	self failWhen: (c isNil or: [c isSeparator]).
	c == $( 
		ifTrue: [
			self nextChar.
			self scanPast: #arrayStart start: currentTokenSourcePosition end: currentTokenSourcePosition + 1.
			^self parseArray].
	c == $' ifTrue: [^self parseSymbolString].
	((self isSelectorCharacter: c) or: [c == $-]) 
		ifTrue: [^self parseSymbolSelector].
	(c isLetter or: [c == $:]) ifTrue: [^self parseSymbolIdentifier].
	^self parseCharSymbol! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 2/17/2007 14:47'!
parseSymbolIdentifier
	| c start end |
	c := self currentChar.
	self failUnless: (c isLetter or: [c == $:]).
	start := sourcePosition.	
	[c := self nextChar.
	c isAlphaNumeric or: [c == $:]] 
		whileTrue: [].
	end := sourcePosition - 1.
	c := source copyFrom: start - 1 to: end.
	self scanPast: #symbol start: start - 1 end: end.
	^c! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 4/28/2004 14:06'!
parseSymbolSelector
	| start end |
	start := sourcePosition - 1.
	end := sourcePosition.
	[self isSelectorCharacter: self nextChar] 
		whileTrue: [end := sourcePosition].
	self scanPast: #symbol start: start end: end! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 2/17/2007 14:47'!
parseSymbolString
	| first c last |
	first := sourcePosition.
	self nextChar.
	[(c := self currentChar) isNil 
		ifTrue: [
			self rangeType: #unfinishedString start: first end: source size.
			self error	": 'unfinished string'"].
	c ~~ $' or: [
		self peekChar == $' 
			ifTrue: [sourcePosition := sourcePosition + 1.true] 
			ifFalse: [false]]
	] whileTrue: [sourcePosition := sourcePosition + 1].
	last := sourcePosition.
	self nextChar.
	self scanPast: #stringSymbol start: first - 1 end: last! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 2/17/2007 14:47'!
parseTerm
	self failWhen: currentToken isNil.
	currentTokenFirst == $( 
		ifTrue: [
			bracketDepth := bracketDepth + 1.
			self scanPast: #leftParenthesis level: bracketDepth.
			self parseExpression.
			self failUnless: currentTokenFirst == $).
			self scanPast: #rightParenthesis level: bracketDepth.
			^bracketDepth := bracketDepth - 1].
	currentTokenFirst == $[ ifTrue: [^self parseBlock].
	currentTokenFirst == ${ 
		ifTrue: [
			self scanPast: #leftBrace.
			^self parseBraceArray].
	self isName ifTrue: [^self scanPast: (self resolve: currentToken)].
	self parseLiteral: false! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 5/7/2004 09:33'!
parseUnary
	| unary type |
	
    [self isName]
        whileTrue: [
			unary := currentToken.
			type := #unary.
			(unary isEmpty or:[Symbol hasInterned: unary ifTrue: [:sym | ]])
				ifFalse:[
					type := (Symbol thatStartsCaseSensitive: unary skipping: nil) isNil
						ifTrue: [#undefinedUnary]
						ifFalse:[#incompleteUnary]].
			self scanPast: type]
! !

!SHParserST80 methodsFor: 'parse' stamp: 'tween 4/17/2004 22:17'!
parseUnaryMessagePattern
	
	 self scanPast: #patternUnary
! !

!SHParserST80 methodsFor: 'parse' stamp: 'jmv 8/18/2009 23:08'!
rangesIn: sourceString classOrMetaClass: aBehaviour workspace: aWorkspace
	self
		workspace: aWorkspace;
		classOrMetaClass: aBehaviour;
		source: sourceString.
	self parse.
	^ranges! !

!SHParserST80 methodsFor: 'recording ranges' stamp: 'tween 4/28/2004 09:54'!
rangeType: aSymbol 
	^self 
		rangeType: aSymbol
		start: currentTokenSourcePosition
		end: currentTokenSourcePosition + currentToken size - 1! !

!SHParserST80 methodsFor: 'recording ranges' stamp: 'tween 4/28/2004 10:20'!
rangeType: aSymbol start: s end: e 
	^ranges add: (SHRange start: s end: e type: aSymbol)! !

!SHParserST80 methodsFor: 'aux' stamp: 'jmv 8/19/2009 17:43'!
has: aDictionaryOrSharedPool bindingThatBeginsWith: aString
	"Answer true if the receiver has a key that begins with aString, false otherwise"
	
	aDictionaryOrSharedPool keysDo: [ :each | 
		(each beginsWith: aString)
			ifTrue: [ ^true ]].
	^false! !


!SHRange methodsFor: 'accessing' stamp: 'tween 4/13/2004 18:55'!
end
	^end! !

!SHRange methodsFor: 'accessing' stamp: 'tween 4/13/2004 18:55'!
end: anInteger
	end := anInteger! !

!SHRange methodsFor: 'accessing' stamp: 'tween 4/24/2004 15:48'!
length
	^end - start + 1! !

!SHRange methodsFor: 'accessing' stamp: 'tween 4/13/2004 18:54'!
start
	^start! !

!SHRange methodsFor: 'accessing' stamp: 'tween 4/13/2004 18:54'!
start: anInteger
	start := anInteger! !

!SHRange methodsFor: 'accessing' stamp: 'tween 2/17/2007 14:03'!
start: startInteger end: endInteger type: typeSymbol
	start := startInteger.
	end := endInteger.
	type := typeSymbol! !

!SHRange methodsFor: 'accessing' stamp: 'tween 4/13/2004 18:55'!
type
	^type! !

!SHRange methodsFor: 'accessing' stamp: 'tween 4/13/2004 18:55'!
type: aSymbol
	type := aSymbol! !


!SHRange class methodsFor: 'instance creation' stamp: 'tween 2/17/2007 14:04'!
start: s end: e type: aSymbol
	
	^self new
		start: s end: e type: aSymbol;
		yourself! !


!SHTextStyler methodsFor: 'styling' stamp: 'tween 8/28/2004 00:21'!
initialize
	stylingEnabled := true
! !

!SHTextStyler methodsFor: 'styling' stamp: 'tween 8/30/2004 12:32'!
style: aText
	self terminateBackgroundStylingProcess.
	stylingEnabled ifTrue:[
		text := aText copy.
		self privateStyle: text.
		view ifNotNil:[view stylerStyled: text] ]! !

!SHTextStyler methodsFor: 'styling' stamp: 'jmv 8/19/2009 15:40'!
styleInBackgroundProcess: aText

	self terminateBackgroundStylingProcess.
	stylingEnabled ifTrue: [
		text := aText copy.
		self monitor critical: [
			sem := Semaphore new. 
			[
				sem notNil ifTrue: [
					sem wait.
					view ifNotNil:[view stylerStyledInBackground: text]]
			] forkAt: Processor activePriority.

			backgroundProcess :=  [
				self privateStyle: text.
				sem signal] newProcess.
			backgroundProcess priority: Processor userBackgroundPriority.
			backgroundProcess resume
		] 
	]! !

!SHTextStyler methodsFor: 'formatting' stamp: 'tween 8/26/2004 02:19'!
format: aText
	"Answer a copy of <aText> which has been reformatted,
	or <aText> if no formatting is to be applied"
	
	self terminateBackgroundStylingProcess.
	^self privateFormat: aText! !

!SHTextStyler methodsFor: 'private' stamp: 'tween 4/9/2004 12:13'!
monitor
	monitor isNil
		ifTrue: [monitor := Monitor new].
	^monitor! !

!SHTextStyler methodsFor: 'private' stamp: 'tween 8/26/2004 02:26'!
privateFormat: aText
	self shouldBeImplemented! !

!SHTextStyler methodsFor: 'private' stamp: 'tween 8/26/2004 02:25'!
privateStyle: aText

	self shouldBeImplemented! !

!SHTextStyler methodsFor: 'private' stamp: 'tween 4/9/2004 12:21'!
terminateBackgroundStylingProcess
	self monitor critical: [
		backgroundProcess 
			ifNotNil: [
				backgroundProcess terminate.
				backgroundProcess := nil].
		sem 
			ifNotNil:[
				sem terminateProcess.
				sem := nil].	
	]		! !

!SHTextStyler methodsFor: 'accessing' stamp: 'tween 8/26/2004 00:30'!
view: aViewOrMorph
	view := aViewOrMorph! !


!SHTextStylerST80 methodsFor: 'private' stamp: 'jmv 8/19/2009 16:05'!
attributesFor: aSymbol 
	^self class attributesFor: aSymbol
	! !

!SHTextStylerST80 methodsFor: 'private' stamp: 'tween 4/28/2004 10:44'!
convertAssignmentsToAnsi: aText
	"If the Preference is to show ansiAssignments then answer a copy of  <aText> where each  left arrow assignment is replaced with a ':=' ansi assignment. A parser is used so that each left arrow is only replaced if it occurs within an assigment statement"

	^self replaceStringForRangesWithType: #assignment with: ':=' in: aText! !

!SHTextStylerST80 methodsFor: 'private' stamp: 'tween 4/28/2004 10:45'!
convertAssignmentsToLeftArrow: aText
	"If the Preference is to show leftArrowAssignments then answer a copy of  <aText> where each ansi assignment (:=) is replaced with a left arrow. A parser is used so that each ':=' is only replaced if it actually occurs within an assigment statement"

	^self replaceStringForRangesWithType: #ansiAssignment with: '_' in: aText! !

!SHTextStylerST80 methodsFor: 'private' stamp: 'tween 8/26/2004 02:55'!
parseableSourceCodeTemplate

	^'messageSelectorAndArgumentNames
	"comment stating purpose of message"

	| temporary variable names |
	statements'! !

!SHTextStylerST80 methodsFor: 'private' stamp: 'tween 8/26/2004 10:53'!
privateFormat: aText
	"Perform any formatting of aText necessary and answer either aText, or a formatted copy of aText"

	aText asString = Object sourceCodeTemplate
		ifTrue:[
			"the original source code template does not parse,
			replace it with one that does"
			^self parseableSourceCodeTemplate asText].
	formatAssignments
		ifTrue:[
			Preferences syntaxHighlightingAsYouTypeAnsiAssignment 
				ifTrue:[^self convertAssignmentsToAnsi: aText].
			Preferences syntaxHighlightingAsYouTypeLeftArrowAssignment 
				ifTrue:[^self convertAssignmentsToLeftArrow: aText]].		
	^aText! !

!SHTextStylerST80 methodsFor: 'private' stamp: 'tween 8/26/2004 03:14'!
privateStyle: aText

	| ranges |
	ranges := self rangesIn: aText setWorkspace: true.
	ranges ifNotNil: [self setAttributesIn: aText fromRanges: ranges]! !

!SHTextStylerST80 methodsFor: 'private' stamp: 'jmv 8/18/2009 23:08'!
rangesIn: aText setWorkspace: aBoolean
	"Answer a collection of SHRanges by parsing aText.
	When formatting it is not necessary to set the workspace, and this can make the parse take less time, so aBoolean specifies whether the parser should be given the workspace"

	parser ifNil: [parser := SHParserST80 new].
	^parser 
		rangesIn: aText asString 
		classOrMetaClass: classOrMetaClass 
		workspace: (aBoolean ifTrue:[workspace])! !

!SHTextStylerST80 methodsFor: 'private' stamp: 'tween 8/9/2005 17:29'!
replaceStringForRangesWithType: aSymbol with: aString in: aText 
	"Answer aText if no replacements, or a copy of aText with 
	each range with a type of aSymbol replaced by aString"
	| answer toReplace increaseInLength start end thisIncrease first last newFirst newLast
	adjustSourceMap |
	
	toReplace := (self rangesIn: aText setWorkspace: false) 
		select: [:each | each type = aSymbol].
	toReplace isEmpty ifTrue: [^aText].
	answer := aText copy.
	increaseInLength := 0.
	adjustSourceMap := sourceMap notNil and:[sourceMap ~~ processedSourceMap].
	(toReplace asSortedCollection: [:a :b | a start <= b start]) 
		do: [:each | 
			start := each start + increaseInLength.
			end := each end + increaseInLength.
			answer 	replaceFrom: start to: end with: aString.
			thisIncrease := aString size - each length.
			increaseInLength := increaseInLength + thisIncrease.
			adjustSourceMap ifTrue:[
				sourceMap do:[:assoc |
					first := newFirst := assoc value first.
					last := newLast := assoc value last.
					first > start ifTrue:[newFirst := first + thisIncrease].
					last > start ifTrue:[newLast := last + thisIncrease].
					(first ~= newFirst or:[last ~= newLast])
						ifTrue:[assoc value: (newFirst to: newLast)]]]].
	adjustSourceMap ifTrue:[processedSourceMap := sourceMap]. 
	^answer! !

!SHTextStylerST80 methodsFor: 'private' stamp: 'jmv 8/19/2009 17:49'!
setAttributesIn: aText fromRanges: ranges
	| charAttr defaultAttr attr newRuns newValues lastAttr lastCount | 		

	defaultAttr := self attributesFor: #default.
	charAttr := Array new: aText size.
	1 to: charAttr size do: [ :i | charAttr at: i put: defaultAttr].
	ranges do: [ :range |
		(attr := self attributesFor: range type) == nil
			ifFalse: [	range start to: range end do: [:i | charAttr at: i put: attr]]].
	newRuns := OrderedCollection new: charAttr size // 10.
	newValues := OrderedCollection new: charAttr size // 10.
	1 to: charAttr size do: [:i |
		attr := charAttr at: i.
		i = 1 
			ifTrue: [
				newRuns add: 1.
				lastCount := 1.
				lastAttr := newValues add: attr]
			ifFalse:[
				attr == lastAttr
					ifTrue: [
						lastCount := lastCount + 1.
						newRuns at: newRuns size put: lastCount]
					ifFalse: [
						newRuns add: 1.
						lastCount := 1.
						lastAttr := newValues add: attr]]].
	aText setRuns: (RunArray runs: newRuns values: newValues)
	! !

!SHTextStylerST80 methodsFor: 'accessing' stamp: 'tween 4/9/2004 12:47'!
classOrMetaClass: aBehavior
	classOrMetaClass := aBehavior! !

!SHTextStylerST80 methodsFor: 'accessing' stamp: 'tween 8/9/2005 15:37'!
sourceMap: aSortedCollection
	"set the receiver's sourceMap to aSortedCollection.
	The sourceMap is used by a Debugger to select the appropriate
	ranges within its text. These ranges need to be adjusted if, and when, the receiver
	reformats the text that is displayed"

	sourceMap := aSortedCollection! !

!SHTextStylerST80 methodsFor: 'accessing' stamp: 'tween 4/15/2004 13:23'!
workspace: aWorkspace
	workspace := aWorkspace! !

!SHTextStylerST80 methodsFor: 'initialize-release' stamp: 'tween 8/28/2004 00:20'!
initialize
	super initialize.
	formatAssignments := true! !


!SHTextStylerST80 class methodsFor: 'preferences' stamp: 'tween 6/27/2004 11:30'!
ansiAssignmentPreferenceChanged
	"the user has changed the syntaxHighlightingAsYouTypeAnsiAssignment setting.
	If they have turned it on then force syntaxHighlightingAsYouTypeLeftArrowAssignment
	to be turned off"
	Preferences syntaxHighlightingAsYouTypeAnsiAssignment 
		ifTrue:[Preferences disable: #syntaxHighlightingAsYouTypeLeftArrowAssignment]! !

!SHTextStylerST80 class methodsFor: 'preferences' stamp: 'jmv 8/18/2009 22:56'!
initializePreferences
	
	(Preferences preferenceAt: #syntaxHighlightingAsYouType) ifNil:[
		Preferences 
			disable: #browseWithPrettyPrint.
		Preferences 
			addPreference: #syntaxHighlightingAsYouType
			 categories: #( browsing)
			default: true 
			balloonHelp: 'Enable, or disable, Shout - Syntax Highlighting As You Type. When enabled, code in Browsers and Workspaces is styled to reveal its syntactic structure. When the code is changed (by typing some characters, for example), the styling is changed so that it remains in sync with the modified code'].
	(Preferences preferenceAt: #syntaxHighlightingAsYouTypeAnsiAssignment) ifNil:[
		Preferences 
			addPreference: #syntaxHighlightingAsYouTypeAnsiAssignment
			 categories: #( browsing)
			default: false 
			balloonHelp: 'If true, and syntaxHighlightingAsYouType is enabled,  all left arrow assignments ( _ ) will be converted to the ANSI format ( := ) when a method is selected in a Browser. Whilst editing a method, this setting has no effect - both the left arrow and the ansi format may be used'.
		(Preferences preferenceAt: #syntaxHighlightingAsYouTypeAnsiAssignment)
			changeInformee: self
			changeSelector: #ansiAssignmentPreferenceChanged].		
	(Preferences preferenceAt: #syntaxHighlightingAsYouTypeLeftArrowAssignment) ifNil:[
		Preferences 
			addPreference: #syntaxHighlightingAsYouTypeLeftArrowAssignment
		 	categories: #( browsing)
			default: false 
			balloonHelp: 'If true, and syntaxHighlightingAsYouType is enabled,  all ANSI format assignments ( := ) will be converted to left arrows ( _ ) when a method is selected in a Browser. Whilst editing a method, this setting has no effect - both the left arrow and the ansi format may be used'.
		(Preferences preferenceAt: #syntaxHighlightingAsYouTypeLeftArrowAssignment)
			changeInformee: self 
			changeSelector: #leftArrowAssignmentPreferenceChanged ].							! !

!SHTextStylerST80 class methodsFor: 'preferences' stamp: 'tween 6/27/2004 11:31'!
leftArrowAssignmentPreferenceChanged
	"the user has changed the syntaxHighlightingAsYouTypeLeftArrowAssignment setting.
	If they have turned it on then force syntaxHighlightingAsYouTypeAnsiAssignment
	to be turned off"
	Preferences syntaxHighlightingAsYouTypeLeftArrowAssignment 
		ifTrue:[Preferences disable: #syntaxHighlightingAsYouTypeAnsiAssignment]! !

!SHTextStylerST80 class methodsFor: 'style table' stamp: 'jmv 8/19/2009 16:01'!
attributeArrayForColor: aColorOrNil emphasis: anEmphasisSymbolOrArrayorNil
	"Answer a new Array containing any non nil TextAttributes specified"
	| answer emphArray |

	answer := Array new.
	aColorOrNil ifNotNil: [answer := answer, {TextColor color: aColorOrNil}].
	anEmphasisSymbolOrArrayorNil ifNotNil: [
		emphArray := anEmphasisSymbolOrArrayorNil isSymbol 
			ifTrue: [{anEmphasisSymbolOrArrayorNil}] 
			ifFalse: [anEmphasisSymbolOrArrayorNil].
		emphArray do: [:each |
			each ~= #normal
				ifTrue:[
					answer := answer, {TextEmphasis perform: each}]]].
	^answer! !

!SHTextStylerST80 class methodsFor: 'style table' stamp: 'jmv 8/19/2009 16:09'!
attributesFor: aSymbol

	textAttributes ifNil: [ textAttributes _ self initialTextAttributes ].
	^ textAttributes at: aSymbol ifAbsent: [ nil ]! !

!SHTextStylerST80 class methodsFor: 'style table' stamp: 'jmv 8/19/2009 16:00'!
defaultStyleTable
	"color can be a valid argument to Color class>>colorFrom: , or nil to
	use the editor text color.
	Multiple emphases can be specified using an array e.g. #(bold italic).
	If emphasis is not specified, #normal will be used.
	"
								
^#(
	"(symbol								color						[emphasisSymbolOrArray])"		
	(default 								black 		)
	(invalid 									red 			)
	(excessCode 							red 			)
	(comment 								(green muchDarker) 		italic)
	(unfinishedComment 					(red muchDarker) 			italic)
	(#'$'									(red muchDarker) 	)
	(character								(red muchDarker) 	)
	(integer								(red muchDarker) 	)
	(number								(red muchDarker) 	)	
	(#-										(red muchDarker) 	)
	(symbol									(blue muchDarker)			bold)	
	(stringSymbol							(blue muchDarker)			bold)	
	(literalArray								(blue muchDarker)			bold)
	(string									(magenta muchDarker)		normal)
	(unfinishedString						red							normal		)
	(assignment							nil							bold			)
	(ansiAssignment 						nil							bold)
	(literal									nil							italic)
	(keyword								(blue muchDarker)			)
	(binary 									(blue muchDarker)			)	
	(unary									(blue muchDarker)			)
	(incompleteKeyword					(gray muchDarker)			underlined)
	(incompleteBinary 						(gray muchDarker)			underlined)	
	(incompleteUnary						(gray muchDarker)			underlined)
	(undefinedKeyword						red			)
	(undefinedBinary 						red			)	
	(undefinedUnary						red			)													
	(patternKeyword 						nil							bold)
	(patternBinary 							nil							bold)
	(patternUnary							nil							bold)	
	(#self 									(red muchDarker)			bold)
	(#super									(red muchDarker)			bold) 
	(#true 									(red muchDarker)			bold)
	(#false 									(red muchDarker)			bold)
	(#nil 									(red muchDarker)			bold)
	(#thisContext 							(red muchDarker)			bold)
	(#return								(red muchDarker)			bold)
	(patternArg 							(blue muchDarker)			italic)	
	(methodArg 							(blue muchDarker)			italic)
	(blockPatternArg 						(blue muchDarker)			italic)
	(blockArg 								(blue muchDarker)			italic)
	(argument 								(blue muchDarker)			italic)
	(blockArgColon							black		) 
	(leftParenthesis							black		) 
	(rightParenthesis						black		) 
	(leftParenthesis1						(green muchDarker)		) 
	(rightParenthesis1						(green muchDarker)		) 
	(leftParenthesis2						(magenta muchDarker)		) 
	(rightParenthesis2						(magenta muchDarker)		) 
	(leftParenthesis3						(red muchDarker)		) 
	(rightParenthesis3						(red muchDarker)		) 
	(leftParenthesis4						(green darker)		) 
	(rightParenthesis4						(green darker)		) 
	(leftParenthesis5						(orange darker)		) 
	(rightParenthesis5						(orange darker)		) 
	(leftParenthesis6						(magenta darker)		) 
	(rightParenthesis6						(magenta darker)		) 
	(leftParenthesis7						blue		) 
	(rightParenthesis7						blue		) 
	(blockStart 								black		) 
	(blockEnd 								black		) 
	(blockStart1							(green muchDarker)			) 
	(blockEnd1								(green muchDarker)			) 
	(blockStart2							(magenta muchDarker)		) 
	(blockEnd2								(magenta muchDarker)		) 
	(blockStart3							(red muchDarker)		) 
	(blockEnd3								(red muchDarker)		) 
	(blockStart4							(green darker)		) 
	(blockEnd4								(green darker)		) 
	(blockStart5							(orange darker)		) 
	(blockEnd5								(orange darker)		) 
	(blockStart6							(magenta darker)		) 
	(blockEnd6								(magenta darker)		) 
	(blockStart7							blue		) 
	(blockEnd7								blue		) 																																																		
	(arrayStart								black		) 
	(arrayEnd								black		) 
	(arrayStart1							black		) 
	(arrayEnd1								black		) 
	(leftBrace 								black		) 
	(rightBrace 								black		) 
	(cascadeSeparator 						black		) 
	(statementSeparator 					black		) 
	(externalCallType 						black		) 
	(externalCallTypePointerIndicator 		black		) 
	(primitiveOrExternalCallStart 			black						bold	) 
	(primitiveOrExternalCallEnd				black						bold	)
	(methodTempBar						gray		) 
	(blockTempBar 							gray		)
	(blockArgsBar							gray		)
	(primitive								(green muchDarker)			bold)
	(pragmaKeyword						(green muchDarker)			bold)
	(pragmaUnary							(green muchDarker)			bold)
	(pragmaBinary							(green muchDarker)			bold)									
	(externalFunctionCallingConvention		(green muchDarker)			bold) 
	(module								(green muchDarker)			bold)
	(blockTempVar 							gray						italic)
	(blockPatternTempVar					gray						italic)
	(instVar 								black						bold)
	(workspaceVar							black						bold)
	(undefinedIdentifier					red							bold)
	(incompleteIdentifier					(gray darker) 				(italic underlined))
	(tempVar								(gray darker)				italic)
	(patternTempVar						(gray darker)				italic)
	(poolConstant							(gray darker)				italic)
	(classVar								(gray darker)				bold)
	(globalVar								black						bold) )
							! !

!SHTextStylerST80 class methodsFor: 'style table' stamp: 'jmv 8/19/2009 16:04'!
initialTextAttributes
	| d element color emphasis attrArray |
	 
	d := IdentityDictionary new.
	self styleTable do: [ :each |
		element := each first.
		color := each at: 2 ifAbsent: [ nil ].
		color:=color ifNotNil: [ Color colorFrom: color].
		emphasis := each at: 3 ifAbsent: [ nil ].
		attrArray := self attributeArrayForColor: color emphasis: emphasis.
		attrArray notEmpty 
			ifTrue: [
				d at: element put: attrArray]].
	^d	
	! !

!SHTextStylerST80 class methodsFor: 'style table' stamp: 'tween 4/18/2004 21:07'!
styleTable
	
	styleTable ifNotNil:[^styleTable].
	^styleTable := self defaultStyleTable.	
						! !

!SHTextStylerST80 class methodsFor: 'class initialization' stamp: 'jmv 8/19/2009 16:07'!
initialize  
	"Clear styleTable and textAttributesByPixelSize cache so that they will 
	reinitialize.	 

		SHTextStylerST80 initialize
	" 
	
	styleTable := nil.
	textAttributes := nil.	
	self initializePreferences! !


!SimpleEditor methodsFor: 'mvc compatibility' stamp: 'jmv 8/19/2009 17:39'!
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" ]! !


!Symbol class methodsFor: 'access' stamp: 'jmv 8/16/2009 11:24'!
thatStartsCaseSensitive: leadingCharacters skipping: skipSym
	"Same as thatStarts:skipping: but caseSensitive"
	| size firstMatch key |

	size := leadingCharacters size.
	size = 0 ifTrue: [^skipSym ifNil: [#''] ifNotNil: [nil]].
	firstMatch := leadingCharacters at: 1.
	size > 1 ifTrue: [key := leadingCharacters copyFrom: 2 to: size].
	self allSymbolTablesDo: [:each |
			each size >= size ifTrue:
				[
					((each at: 1) == firstMatch and:
						[key == nil or:
							[(each findString: key startingAt: 2 caseSensitive: true) = 2]])
								ifTrue: [^each]
				]
		] after: skipSym.

	^nil
! !


!Text methodsFor: 'private' stamp: 'jmv 8/19/2009 17:48'!
setRuns: anArray

	runs _ anArray! !


!TextEditor methodsFor: 'mvc compatibility' stamp: 'jmv 8/16/2009 18:18'!
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: 'parenblinking' stamp: 'jmv 8/18/2009 22:32'!
blinkParen
	lastParenLocation ifNotNil: [
		self text string size >= lastParenLocation ifTrue: [
			self text
				addAttribute: TextEmphasis bold
				from: lastParenLocation
				to: lastParenLocation]]! !

!TextEditor methodsFor: 'parenblinking' stamp: 'jmv 8/16/2009 18:31'!
clearParens
	lastParenLocation ifNotNil: [
		self text string size >= lastParenLocation ifTrue: [
			self text
				removeAttribute: TextEmphasis bold
				from: lastParenLocation
				to: lastParenLocation]].
	lastParenLocation := nil! !


!Workspace methodsFor: '*Shout-Styling' stamp: 'jmv 8/19/2009 18:15'!
shoutAboutToStyle: aSHTextStyler
	"This is a notification that aSHTextStyler is about to re-style its text.
	The default is to answer false to veto the styling"
	
	^true! !


!Workspace reorganize!
('binding' bindingOf:)
('accessing' setBindings:)
('as yet unclassified' saveContentsInFile)
('drag and drop' acceptDroppingMorph:event:inMorph:)
('menu commands' addModelItemsToWindowMenu: appendContentsOfFile)
('code pane menu' editorClass)
('*Shout-Styling' shoutAboutToStyle:)
!

SmalltalkEditor removeSelector: #changeEmphasis:!
SHTextStylerST80 initialize!
!classDefinition: #PluggableTextMorph category: #'Morphic-Windows'!
ScrollPane subclass: #PluggableTextMorph
	instanceVariableNames: 'textMorph getTextSelector setTextSelector getSelectionSelector hasUnacceptedEdits askBeforeDiscardingEdits selectionInterval hasEditingConflicts editorClass styler unstyledAcceptText'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Windows'!
