'From Squeak 1.2 of June 29, 1997 on 7 October 1997 at 1:26:24 am'!Parser subclass: #SyntaxHighlightingParser
	instanceVariableNames: 'colorText runs controlStream sourceClass '
	classVariableNames: 'DoSyntaxHighlighting EmphasizeBuffer '
	poolDictionaries: ''
	category: 'Interface-SyntaxHighlighting'!
TextAttribute subclass: #SyntaxHighlightingTextAttribute
	instanceVariableNames: 'name emphasisCode fontNumber color setMode '
	classVariableNames: 'Palette '
	poolDictionaries: ''
	category: 'Interface-SyntaxHighlighting'!

!Browser methodsFor: 'initialize-release' stamp: 'mtw 8/26/97 23:48'!
defaultBackgroundColor
	^#white
	"^ #lightGreen"! !


!BrowserCodeView methodsFor: 'updating' stamp: 'mtw 10/6/97 22:59'!
updateDisplayContents
	"Refer to the comment in StringHolderView|updateDisplayContents."
	| contents |
	contents _ model contents.
	displayContents asString ~= contents
		ifTrue: 
			[model messageListIndex ~= 0
				ifTrue: [SyntaxHighlightingParser doSyntaxHighlighting 
						ifTrue: [contents _ SyntaxHighlightingParser new emphasize: contents inClass: controller model selectedClass]
						ifFalse: [contents _ contents asText makeSelectorBoldIn: model selectedClassOrMetaClass]
].
			self editString: contents.
			self displayView.
			model editSelection == #newMessage ifTrue: [controller selectFrom: 1 to: contents size]]! !


!CodeBrowser methodsFor: 'input events' stamp: 'mtw 10/6/97 23:09'!
messagePaneNewSelection: arg1 
	| contents |
	codePane scroller removeAllMorphs.
	arg1 ifNil: [^ self].
	SyntaxHighlightingParser doSyntaxHighlighting
		ifTrue: [contents _ SyntaxHighlightingParser new emphasize: (self selectedClassOrMetaClass sourceMethodAt: arg1)
						inClass: self selectedClassOrMetaClass]
		ifFalse: [contents _ contents asText makeSelectorBoldIn: (self selectedClassOrMetaClass sourceMethodAt: arg1)]. 
	codePane scroller addMorph: (TextMorph new contents: contents)! !


!ContextStackCodeView methodsFor: 'updating' stamp: 'mtw 10/6/97 23:27'!
updateDisplayContents
	"Refer to the comment in StringHolderView|updateDisplayContents."
	| contents |
	contents _ model contents.
	displayContents string ~= contents 
		ifTrue: 
			[SyntaxHighlightingParser doSyntaxHighlighting
				ifTrue: [displayContents _ (SyntaxHighlightingParser new emphasize: contents inClass: model selectedClassOrMetaClass) asParagraph]
				ifFalse: [displayContents _ (contents asText makeSelectorBoldIn: model selectedClassOrMetaClass) asParagraph].
			self positionDisplayContents.
			self controller changeParagraph: displayContents.
			self displayView.
			self highlightPC]! !


SyntaxHighlightingParser comment:
'SyntaxHighlightingParser makes emphasized Text of Method-Strings. The emphasizes are named SyntaxHighlightingAttributes and can be changed at the class-side of SyntaxHighlightingAttributes to your favorite-style. 
To get rid of SyntaxHighlighting (Perhaps because you think it''s to slow on your system) just press leftShift while browsing one method. All following browsed methods are without SyntaxHighlighting. To reactivate it again just press leftShift again while browsing.

The SyntaxHighlightingParser is called  with #emphasize:inClass: . In this first release only connected to  System-Tools with three different methods (that enables it only to emphasizes when browsing, not jet when accepting or formating) :
BrowserCodeView updateDisplayContents (for Browser)
ContextStackCodeView updateDisplayContents (for Debugger)
CodeBrowser messagePaneNewSelection: (for the Demo-Morphic-Browser)

SyntaxHighlightingParser gets its abilities just from its superclass Parser, so every change on Parser may have influence to SyntaxHighlighting. Since most methods are just copied down and enlarged with #emphasizeSourceTextAs:from:to: , everybody who changes Parser may also change SyntaxHighlightingParser (For example if we finally get block-Local-Variables).

There are still a view little bugs in this release (wrong highligthing with some literals) and many possibilities to integrate it better with the system. Since I did this for VisualWorks before and had to change it very often when the Tools and Widgets changed I leave that for now, because of the upcoming Morphic-Views.
(September 97, Martin Wollenweber, D-45879-Gelsenkirchen, Germany, wollenweber@cww.de)

Instance Variables
colorText <Text> the emphasized SourceText
runs <RunArray> the runs of colorText to influence it directly for more speed
controlStream <TextStream> a Stream that is written and displayed in Transcript when commandKey (Alt) is pressed, to control the work of SyntaxHighlightingParser
sourceClass <Class> as name says ...

Class Variables
DoSyntaxHighlighting <Boolean> toggle for switching on and of
EmphasizeBuffer <OrderedCollection of: (Array with: Class with:Text)> Buffer for faster highlighting while browsing with the disatvantage of getteing sometimes wrong highlightings after Changes. It is activated in #useBuffer
'!

!SyntaxHighlightingParser methodsFor: 'emphasizing' stamp: 'mtw 10/7/97 00:47'!
emphasize: aString 
	colorText _ aString asText addAttribute: (SyntaxHighlightingTextAttribute getAttributeNamed: #allOther).
	runs _ colorText runs.
	self
		parse: (ReadStream on: aString)
		class: sourceClass
		noPattern: false
		context: nil 
		notifying: nil
		ifFail: [^ colorText].
	colorText runs setRuns: runs runs setValues: runs values.
	^colorText! !

!SyntaxHighlightingParser methodsFor: 'emphasizing' stamp: 'mtw 10/7/97 01:00'!
emphasizeSourceTextAs: aSymbol from: tokenStart to: tokenEnd 
	InputSensor default commandKeyPressed ifTrue: [controlStream nextPutAll: (colorText size printString , ' ' , tokenStart printString , ' ' , tokenEnd printString , ' ' , (colorText copyFrom: tokenStart to: tokenEnd) , ' ' , aSymbol) asText;
		 nextPut: Character cr]. 
	runs _ runs
				copyReplaceFrom: tokenStart
				to: tokenEnd
				with: (RunArray new: tokenEnd - tokenStart + 1 withAll: (SyntaxHighlightingTextAttribute getAttributeNamed: aSymbol))! !

!SyntaxHighlightingParser methodsFor: 'emphasizing' stamp: 'mtw 10/7/97 01:03'!
emphasizeWithBuffer: aString 
	EmphasizeBuffer isNil ifTrue: [EmphasizeBuffer _ OrderedCollection new].
	(colorText _ self getBufferedColorText: aString inClass: sourceClass) isNil
		ifTrue: 
			[colorText _ self emphasize: aString.
			EmphasizeBuffer add: (Array with: sourceClass with: colorText).
			[EmphasizeBuffer size > self bufferSize]
				whileTrue: [EmphasizeBuffer removeFirst].
			nil].
	^ colorText ! !

!SyntaxHighlightingParser methodsFor: 'emphasizing' stamp: 'mtw 10/7/97 00:48'!
getBufferedColorText: aString inClass: class 
	| stringSize aColorText |
	EmphasizeBuffer do: 
		[:eEmphArray |  
		(((eEmphArray at: 1)
			= class and: [(stringSize _ aString size) = (aColorText _ eEmphArray at: 2) size])
			and: [(aString asString charactersExactlyMatching: aColorText)
					= stringSize]) 
			ifTrue: [^ aColorText].
		nil]. 
	^ nil! !

!SyntaxHighlightingParser methodsFor: 'public access' stamp: 'mtw 10/7/97 00:48'!
bufferSize
	^100! !

!SyntaxHighlightingParser methodsFor: 'public access' stamp: 'mtw 10/7/97 01:01'!
emphasize: aString inClass: class 
	controlStream _ TextStream on: ''.
	controlStream nextPut: Character cr.
	sourceClass _ class.
	Cursor wait
		showWhile: [self useBuffer
				ifTrue: [self emphasizeWithBuffer: aString]
				ifFalse: [self emphasize: aString]]. 
	InputSensor default commandKeyPressed ifTrue: [Transcript show: controlStream contents].
	^ colorText! !

!SyntaxHighlightingParser methodsFor: 'public access' stamp: 'mtw 10/7/97 00:35'!
useBuffer
	^true! !

!SyntaxHighlightingParser methodsFor: 'expression types' stamp: 'mtw 9/21/97 09:25'!
argumentName
	| anArgumentName varEnd varStart |
	varStart _ self startOfNextToken + requestorOffset.
	hereType == #word ifFalse: [^ self expected: 'Argument name'].
	anArgumentName _ self advance.
	varEnd _ self endOfLastToken + requestorOffset.
	self
		emphasizeSourceTextAs: #argumentVariable
		from: varStart
		to: varEnd.
	^ anArgumentName ! !

!SyntaxHighlightingParser methodsFor: 'expression types' stamp: 'mtw 10/2/97 22:20'!
assignment: varNode 
	| loc |
	self
		emphasizeSourceTextAs: #leftArrow
		from: hereMark
		to: hereMark + 1.
	(loc _ varNode assignmentCheck: encoder at: prevMark + requestorOffset) >= 0 ifTrue: [^ self notify: 'Cannot store into' at: loc].
	varNode nowHasDef.
	self advance.
	self expression ifFalse: [^ self expected: 'Expression'].
	parseNode _ AssignmentNode new
				variable: varNode
				value: parseNode
				from: encoder.
	^ true! !

!SyntaxHighlightingParser methodsFor: 'expression types' stamp: 'mtw 10/5/97 23:11'!
getEmphasizeForVarNode: aVarNode 
	| aKey |
	((aKey _ aVarNode key) isKindOf: Association)
		ifTrue: 
			[((sourceClass classPool keys) includes: aKey key)ifTrue: [^ #classVariable].
			(Undeclared keys includes: aKey key)ifTrue: [^ #undefinedVariable].
			(aKey value isKindOf: Behavior)
				ifTrue: [^ #className].
			^ #globalVariable].
	(#(nil true false self super ) includes: aKey asSymbol)
		ifTrue: [^ #pseudoVariable].
	aVarNode isTemp
		ifTrue: 
			[aVarNode isArg ifTrue: [^ #argumentVariable].
			^ #localVariable].
	^ #instanceVariable! !

!SyntaxHighlightingParser methodsFor: 'expression types' stamp: 'mtw 10/4/97 21:40'!
messagePart: level repeat: repeat 
	| start receiver selector args precedence words keywordStart keywordEnd |
	false ifTrue: [^ super messagePart: level repeat: repeat].
	
	[receiver _ parseNode.
	(hereType == #keyword and: [level >= 3])
		ifTrue: 
			[start _ self startOfNextToken.
			selector _ WriteStream on: (String new: 32).
			args _ OrderedCollection new.
			words _ OrderedCollection new.
			[hereType == #keyword] 
				whileTrue: 
					[keywordStart _ self startOfNextToken + requestorOffset.
					selector nextPutAll: self advance.
					words addLast: (keywordStart to: (keywordEnd _ self endOfLastToken + requestorOffset)).
					self primaryExpression ifFalse: [^ self expected: 'Argument'].
					self
						emphasizeSourceTextAs: #messageSelectorPart
						from: keywordStart
						to: keywordEnd.
					self messagePart: 2 repeat: true.
					args addLast: parseNode].
			(Symbol hasInterned: selector contents ifTrue: [:sym | selector _ sym])
				ifFalse: [selector _ self
								correctSelector: selector contents
								wordIntervals: words
								exprInterval: (start to: self endOfLastToken)
								ifAbort: [^ self fail]].
			precedence _ 3]
		ifFalse: [((hereType == #binary or: [hereType == #verticalBar])
				and: [level >= 2])
				ifTrue: 
					[start _ self startOfNextToken.
					selector _ self advance asSymbol.
					self primaryExpression ifFalse: [^ self expected: 'Argument'].
					self
						emphasizeSourceTextAs: #messageSelectorPart
						from: start
						to: start.
					self messagePart: 1 repeat: true.
					args _ Array with: parseNode.
					precedence _ 2]
				ifFalse: [hereType == #word
						ifTrue: 
							[start _ self startOfNextToken.
							selector _ self advance.
							args _ #().
							words _ OrderedCollection with: (start + requestorOffset to: (keywordEnd _ self endOfLastToken + requestorOffset)).
							(Symbol hasInterned: selector ifTrue: [:sym | selector _ sym])
								ifFalse: [selector _ self
												correctSelector: selector
												wordIntervals: words
												exprInterval: (start to: self endOfLastToken)
												ifAbort: [^ self fail]].
							self
								emphasizeSourceTextAs: #messageSelectorPart
								from: start
								to: keywordEnd.
							precedence _ 1]
						ifFalse: [^ args notNil]]].
	parseNode _ MessageNode new
				receiver: receiver
				selector: selector
				arguments: args
				precedence: precedence
				from: encoder
				sourceRange: (start to: self endOfLastToken).
	repeat] whileTrue.
	^ true! !

!SyntaxHighlightingParser methodsFor: 'expression types' stamp: 'mtw 10/4/97 21:25'!
pattern: fromDoit inContext: ctxt 
	" unarySelector | binarySelector arg | keyword arg {keyword arg} =>  
	{selector, arguments, precedence}."
	| args selector answer start end |
	fromDoit
		ifTrue: [ctxt == nil
				ifTrue: [^ Array
						with: #DoIt
						with: #()
						with: 1]
				ifFalse: [^ Array
						with: #DoItIn:
						with: (Array with: (encoder encodeVariable: 'homeContext'))
						with: 3]].
	hereType == #word 
		ifTrue: 
			[start _ self startOfNextToken + requestorOffset.
			answer _ Array
						with: self advance asSymbol
						with: #()
						with: 1.
			end _ self endOfLastToken + requestorOffset.
					self
						emphasizeSourceTextAs: #methodNamePart
						from: start
						to: end.

			^ answer].
	(hereType == #binary or: [hereType == #verticalBar])
		ifTrue: 
			[selector _ self advance asSymbol.
			args _ Array with: (encoder bindArg: self argumentName).
			^ Array
				with: selector
				with: args
				with: 2].
	hereType == #keyword
		ifTrue: 
			[selector _ WriteStream on: (String new: 32).
			args _ OrderedCollection new.
			[hereType == #keyword]
				whileTrue: 
					[start _ self startOfNextToken + requestorOffset.
					selector nextPutAll: self advance.
					end _ self endOfLastToken + requestorOffset.
					self
						emphasizeSourceTextAs: #methodNamePart
						from: start
						to: end.
					args addLast: (encoder bindArg: self argumentName)].
			^ Array
				with: selector contents asSymbol
				with: args
				with: 3].
	^ self expected: 'Message pattern'! !

!SyntaxHighlightingParser methodsFor: 'expression types' stamp: 'mtw 10/6/97 18:30'!
primaryExpression
	hereType == #word
		ifTrue: 
			[parseNode _ self variable.
			(parseNode isUndefTemp and: [self interactive])
				ifTrue: [self queryUndefined].
			parseNode nowHasRef.
			^ true].
	hereType == #leftBracket
		ifTrue: 
			[self advance.
			self blockExpression.
			^ true].
	hereType == #leftBrace
		ifTrue: 
			[self braceExpression.
			^ true].
	hereType == #leftParenthesis
		ifTrue: 
			[self advance.
			self expression ifFalse: [^ self expected: 'expression'].
			(self match: #rightParenthesis)
				ifFalse: [^ self expected: 'right parenthesis'].
			^ true].
	hereType == #string
		ifTrue: 
			[parseNode _ encoder encodeLiteral: self advance.
			"self
				emphasizeSourceTextAs: #literalConstant
				from: prevMark + 1
				to: self endOfLastToken + 1."
			^ true].
	(hereType == #number or: [hereType == #literal])
		ifTrue: 
			[
			parseNode _ encoder encodeLiteral: self advance.
			"Transcript show: parseNode key printString,' ',parseNode key class printString;cr."
			(parseNode key isKindOf: Number)ifTrue:[self
				emphasizeSourceTextAs: #literalConstant
				from: prevMark
				to: prevMark+parseNode key printString size-1].
			(parseNode key isKindOf: Symbol)ifTrue:[self
				emphasizeSourceTextAs: #literalConstant
				from: prevMark-1
				to: prevMark+parseNode key size-1].
	          (parseNode key isKindOf: Array)ifTrue:[].
			^ true].
	(here == #- and: [tokenType == #number])
		ifTrue: 
			[self advance.
			parseNode _ encoder encodeLiteral: self advance negated.
			^ true].
	^ false! !

!SyntaxHighlightingParser methodsFor: 'expression types' stamp: 'mtw 10/6/97 00:48'!
scanLitVec
	| s |
	true ifTrue: [^ super scanLitVec].
	s _ WriteStream on: (Array new: 16).
	[tokenType = #rightParenthesis or: [tokenType = #doIt]]
		whileFalse: 
			[tokenType = #leftParenthesis
				ifTrue: [self scanToken; scanLitVec]
				ifFalse: [tokenType = #word | (tokenType = #keyword)
						ifTrue: [self scanLitWord]
						ifFalse: [(token == #- and: [(typeTable at: hereChar asciiValue)
									= #xDigit])
								ifTrue: 
									[self scanToken.
									token _ token negated]]].
			s nextPut: token.
			self scanToken].
	token _ s contents! !

!SyntaxHighlightingParser methodsFor: 'expression types' stamp: 'mtw 10/6/97 18:07'!
statements: argNodes innerBlock: inner 
	| stmts returns start more blockComment |
	stmts _ OrderedCollection new.
	"give initial comment to block, since others trail statements"
	blockComment _ currentComment.
	currentComment _ nil.
	returns _ false. 
	more _ hereType ~~ #rightBracket.
	[more]
		whileTrue: 
			[start _ self startOfNextToken.
			(returns _ self match: #upArrow)
				ifTrue: 
					[self
						emphasizeSourceTextAs: #upArrow
						from: prevMark
						to: self endOfLastToken.
					self expression ifFalse: [^ self expected: 'Expression to return'].
					self addComment.
					stmts addLast: (parseNode isReturningIf
							ifTrue: [parseNode]
							ifFalse: [ReturnNode new
									expr: parseNode
									encoder: encoder
									sourceRange: (start to: self endOfLastToken)])]
				ifFalse: [self expression
						ifTrue: 
							[self addComment.
							stmts addLast: parseNode]
						ifFalse: 
							[self addComment.
							stmts size = 0 ifTrue: [stmts addLast: (encoder encodeVariable: (inner
											ifTrue: ['nil']
											ifFalse: ['self']))]]].
			returns
				ifTrue: 
					[self match: #period.
					(hereType == #rightBracket or: [hereType == #doIt])
						ifFalse: [^ self expected: 'End of block']].
			more _ returns not and: [self match: #period]].
	parseNode _ BlockNode new
				arguments: argNodes
				statements: stmts
				returns: returns
				from: encoder.
	parseNode comment: blockComment.
	^ true! !

!SyntaxHighlightingParser methodsFor: 'expression types' stamp: 'mtw 9/21/97 23:03'!
temporaries
	| vars aNode |
	(self match: #verticalBar)
		ifFalse: 
			[tempsMark _ hereMark.
			^ #()].
	vars _ OrderedCollection new.
	[hereType == #word]
		whileTrue: 
			[aNode := (encoder bindTemp: self advance).
			self
				emphasizeSourceTextAs: #localVariable
				from: prevMark
				to: (hereMark-1).
			vars addLast: aNode].
	(self match: #verticalBar)
		ifTrue: 
			[tempsMark _ prevMark.
			^ vars].
	^ self expected: 'Vertical bar'! !

!SyntaxHighlightingParser methodsFor: 'expression types' stamp: 'mtw 10/4/97 16:21'!
variable
	| varName varStart varEnd aVarNode |
	varStart _ self startOfNextToken + requestorOffset.
	varName _ self advance.
	varEnd _ self endOfLastToken + requestorOffset.
	aVarNode _ encoder encodeVariable: varName ifUnknown: [self correctVariable: varName interval: (varStart to: varEnd)].
	self
		emphasizeSourceTextAs: (self getEmphasizeForVarNode: aVarNode)
		from: varStart
		to: varEnd.
	^ aVarNode ! !

!SyntaxHighlightingParser methodsFor: 'multi-character scans' stamp: 'mtw 10/6/97 17:33'!
xDollar
	"Form a Character literal."

	self step. "pass over $"
	token _ self step.
	self
				emphasizeSourceTextAs: #literalConstant
				from: mark-1
				to: mark+1.
	tokenType _ #number "really should be Char, but rest of compiler doesn't know"! !

!SyntaxHighlightingParser methodsFor: 'multi-character scans' stamp: 'mtw 10/6/97 17:44'!
xDoubleQuote
	| aStream stopChar commentStart |
	false ifTrue: [^ super xDoubleQuote].
	commentStart _ mark.
	stopChar _ 30 asCharacter.
	aStream _ WriteStream on: (String new: 200).
	self step.
	
	[aStream nextPut: self step.
	hereChar == $"]
		whileFalse: [(hereChar == stopChar and: [source atEnd])
				ifTrue: [^ self offEnd: 'Unmatched comment quote']].
	self step.
	currentComment == nil
		ifTrue: [currentComment _ OrderedCollection with: aStream contents]
		ifFalse: [currentComment add: aStream contents].
	self 
		emphasizeSourceTextAs: #comment
		from: commentStart
		to: commentStart + aStream contents size+1.
	self scanToken! !

!SyntaxHighlightingParser methodsFor: 'multi-character scans' stamp: 'mtw 10/6/97 18:11'!
xLitQuote
	| start tokenStart |
	tokenStart _ mark.
	self step.
	self scanToken.
	tokenType = #leftParenthesis
		ifTrue: 
			[start _ mark.
			self scanToken; scanLitVec.
			self
				emphasizeSourceTextAs: #literalConstant
				from: tokenStart 
				to: mark.
			tokenType == #doIt
				ifTrue: 
					[mark _ start.
					self offEnd: 'Unmatched parenthesis']]
		ifFalse: [(#(word keyword colon ) includes: tokenType)
				ifTrue: [self scanLitWord]
				ifFalse: [tokenType == #literal
						ifTrue: 
							[(token isMemberOf: Association)
								ifTrue: [token _ nil -> token key].
							(token isMemberOf: Symbol)
								ifTrue: [token _ token -> nil]]]].
	tokenType _ #literal! !

!SyntaxHighlightingParser methodsFor: 'multi-character scans' stamp: 'mtw 10/6/97 17:41'!
xSingleQuote
	| stringStart |
	stringStart _ mark.
	self step.
	buffer reset.
	[hereChar = $'
		and: [aheadChar = $'
				ifTrue: 
					[self step.
					false]
				ifFalse: [true]]]
		whileFalse: 
			[buffer nextPut: self step.
			(hereChar = 30 asCharacter and: [source atEnd])
				ifTrue: [^ self offEnd: 'Unmatched string quote']].
	self step.
	token _ buffer contents.
	tokenType _ #string.
	self
		emphasizeSourceTextAs: #literalConstant
		from: stringStart
		to: stringStart + token size + 1! !

!SyntaxHighlightingParser methodsFor: 'error handling' stamp: 'mtw 10/6/97 22:36'!
notify: string at: location
	"Do all Errors silent"
	^self fail
! !


!SyntaxHighlightingParser class methodsFor: 'class accesing' stamp: 'mtw 10/7/97 01:05'!
doSyntaxHighlighting
	"Every time before SyntaxHighlighting is used we ask if we should use 
	it. When Shift is pressed at this moment we switch the use/dontuse-state"
	DoSyntaxHighlighting isNil ifTrue: [DoSyntaxHighlighting _ true].
	InputSensor default leftShiftDown ifTrue: [DoSyntaxHighlighting _ DoSyntaxHighlighting not].
	DoSyntaxHighlighting ifFalse: [EmphasizeBuffer _ OrderedCollection new].
	^ DoSyntaxHighlighting ! !


SyntaxHighlightingTextAttribute comment:
'Look for comment of SyntaxHighlightingParser'!

!SyntaxHighlightingTextAttribute methodsFor: 'all' stamp: 'mtw 10/4/97 16:21'!
color
	^ color! !

!SyntaxHighlightingTextAttribute methodsFor: 'all' stamp: 'mtw 10/4/97 16:21'!
color: aColor
	color _ aColor! !

!SyntaxHighlightingTextAttribute methodsFor: 'all' stamp: 'mtw 10/4/97 16:21'!
dominates: another
	"Subclasses may override condense multiple attributes"
	^ true! !

!SyntaxHighlightingTextAttribute methodsFor: 'all' stamp: 'mtw 10/4/97 16:21'!
emphasisCode
	^ emphasisCode! !

!SyntaxHighlightingTextAttribute methodsFor: 'all' stamp: 'mtw 10/4/97 16:21'!
emphasisCode: int
	emphasisCode _ int.
	setMode _ true! !

!SyntaxHighlightingTextAttribute methodsFor: 'all' stamp: 'mtw 10/4/97 17:42'!
emphasizeScanner: scanner
	"Set the emphasist for text display"
	scanner addEmphasis: emphasisCode. 
	"Set the font for text display"
	scanner setFont: fontNumber.
	"Set the emphasis for text display"
	scanner textColor: color! !

!SyntaxHighlightingTextAttribute methodsFor: 'all' stamp: 'mtw 10/4/97 16:21'!
fontNumber
	^ fontNumber! !

!SyntaxHighlightingTextAttribute methodsFor: 'all' stamp: 'mtw 10/4/97 16:21'!
fontNumber: int
	fontNumber _ int! !

!SyntaxHighlightingTextAttribute methodsFor: 'all' stamp: 'mtw 10/4/97 16:21'!
name
	^name ! !

!SyntaxHighlightingTextAttribute methodsFor: 'all' stamp: 'mtw 10/4/97 16:21'!
name: aName
	name := aName.! !

!SyntaxHighlightingTextAttribute methodsFor: 'all' stamp: 'mtw 10/4/97 16:21'!
printOn: strm
	super printOn: strm.
	strm nextPutAll: ' ',name.! !

!SyntaxHighlightingTextAttribute methodsFor: 'all' stamp: 'mtw 10/4/97 16:21'!
set
	true ifTrue:[^true].
	^ setMode and: [emphasisCode ~= 0]! !

!SyntaxHighlightingTextAttribute methodsFor: 'all' stamp: 'mtw 10/4/97 16:21'!
turnOff
	setMode _ false! !


!SyntaxHighlightingTextAttribute class methodsFor: 'instance creation' stamp: 'mtw 10/4/97 17:42'!
newName: aName color: aColor emphasis: anEmphasis fontNr: aFontNr 
	| aNewAtt |
	aNewAtt _ self new.
	aNewAtt name: aName;
	 color: aColor;
	 emphasisCode: anEmphasis emphasisCode;
	 fontNumber: aFontNr.
	^ aNewAtt ! !

!SyntaxHighlightingTextAttribute class methodsFor: 'class accessing' stamp: 'mtw 10/4/97 16:21'!
getAttributeNamed: aName
	^(Palette at: aName)! !

!SyntaxHighlightingTextAttribute class methodsFor: 'class initialization' stamp: 'mtw 10/6/97 22:30'!
allAttributeNames
	^#(allOther className globalVariable methodNamePart messageSelectorPart comment argumentVariable localVariable  instanceVariable classVariable pseudoVariable undefinedVariable undefinedVariable literalConstant leftArrow upArrow)! !

!SyntaxHighlightingTextAttribute class methodsFor: 'class initialization' stamp: 'mtw 10/4/97 21:10'!
changeAttributeNamed: aName color: aColor 
  (Palette at: aName)color: aColor! !

!SyntaxHighlightingTextAttribute class methodsFor: 'class initialization' stamp: 'mtw 10/6/97 23:12'!
chooseColorOfAnAttribute
	"SyntaxHighlightingTextAttribute chooseColorOfAnAttribute"
	SyntaxHighlightingTextAttribute changeAttributeNamed: (SelectionMenu selections: (SyntaxHighlightingTextAttribute allAttributeNames)) startUp asSymbol color: Color fromUser
! !

!SyntaxHighlightingTextAttribute class methodsFor: 'class initialization' stamp: 'mtw 10/6/97 23:13'!
initialize
	"SyntaxHighlightingTextAttribute initialize"
	"SyntaxHighlightingTextAttribute changeAttributeNamed: ((((SelectionMenu selections:(SyntaxHighlightingTextAttribute allAttributeNames))startUp)asSymbol)) color: Color fromUser"

	Palette _ Dictionary new.
	self makeAllAttributes! !

!SyntaxHighlightingTextAttribute class methodsFor: 'class initialization' stamp: 'mtw 10/6/97 23:19'!
makeAllAttributes
	"SyntaxHighlightingTextAttribute initialize"
	self
		makeAttributeNamed: #allOther
		color: (Color black)
		emphasis: TextEmphasis normal
		fontNr: 1.
	self
		makeAttributeNamed: #className
		color: (Color r:0 g:0.4 b: 0.2)
		emphasis: TextEmphasis bold
		fontNr: 1.
	self
		makeAttributeNamed: #globalVariable
		color: Color magenta
		emphasis: TextEmphasis bold
		fontNr: 1.
	self
		makeAttributeNamed: #methodNamePart
		color: Color black
		emphasis: TextEmphasis bold
		fontNr: 1.
	self
		makeAttributeNamed: #messageSelectorPart
		color: Color darkGray
		emphasis: TextEmphasis normal
		fontNr: 1.
	self
		makeAttributeNamed: #comment
		color: Color red
		emphasis: TextEmphasis normal
		fontNr: 1.
	self
		makeAttributeNamed: #argumentVariable
		color: (Color r:0.0 g:0.4 b: 1.0)
		emphasis: TextEmphasis normal
		fontNr: 1.
	self
		makeAttributeNamed: #localVariable
		color: Color blue
		emphasis: TextEmphasis normal
		fontNr: 1.
	self
		makeAttributeNamed: #instanceVariable
		color: (Color r:0.2 g:0 b:0.6)
		emphasis: TextEmphasis bold
		fontNr: 1.
	self
		makeAttributeNamed: #classVariable
		color: (Color r:0.2 g:0 b:0.6) 
		emphasis: TextEmphasis bold
		fontNr: 1.
	self
		makeAttributeNamed: #pseudoVariable
		color: (Color r:0.2 g:0 b:0.6)
		emphasis: TextEmphasis italic
		fontNr: 1.
	self
		makeAttributeNamed: #undefinedVariable
		color: Color black
		emphasis: TextEmphasis struckOut
		fontNr: 1.
	self
		makeAttributeNamed: #literalConstant
		color: Color brown
		emphasis: TextEmphasis normal
		fontNr: 1.
	self
		makeAttributeNamed: #leftArrow
		color: Color orange
		emphasis: TextEmphasis bold
		fontNr: 1.
	self
		makeAttributeNamed: #upArrow
		color: Color orange
		emphasis: TextEmphasis bold
		fontNr: 1! !

!SyntaxHighlightingTextAttribute class methodsFor: 'class initialization' stamp: 'mtw 10/6/97 23:12'!
makeAttributeNamed: aName color: aColor emphasis: anEmphasis fontNr: aFontNr
  Palette at: aName
			put: (SyntaxHighlightingTextAttribute
					newName: aName
					color: aColor
					emphasis: anEmphasis
					fontNr: aFontNr)! !


SyntaxHighlightingTextAttribute initialize!