'From Squeak 2.0 of May 22, 1998 on 11 June 1998 at 3:16:13 am'!
"Change Set:		SyntaxHighlighting

Date:			11 June 1998
Author:			Helge Horch, hhorch@wuerzburg.netsurf.de
Version:			Squeak 2.0

Original date:	29 June 1997
Original author:	Martin Wollenweber, wollenweber@cww.de
Original version: Squeak 1.2

Syntax highlighting for Smalltalk source code."!

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'!

!SyntaxHighlightingParser commentStamp: 'hh 6/11/1998 03:16' prior: 0!
A SyntaxHighlightingParser makes emphasized Text of method strings.

The emphasises are SyntaxHighlightingTextAttributes and can be changed at the class side of SyntaxHighlightingTextAttributes to your favorite style (e.g. see its class method makeAllAttributes).

To get rid of SyntaxHighlighting (perhaps because you think it's too slow on your system) just press leftShift while browsing one method. All following browsed methods are without SyntaxHighlighting. To reactivate it, just press leftShift again while browsing. You can query the current state with "SyntaxHighlightingParser doHighlighting."

The SyntaxHighlightingParser is called with #emphasize:inClass: and it has been hooked into Text>>makeSelectorBoldIn:

In this first release only connected to  System-Tools with three different methods
	(that enables it only to emphasize when browsing, not yet when accepting or formatting) :
* 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 effects on SyntaxHighlighting. Since most methods are just copied down and enlarged with #emphasizeSourceTextAs:from:to: , everybody who changes Parser may also want to change SyntaxHighlightingParser (for example if we finally get block locals).

There are still a few 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)

Adapted for pluggable views by Helge Horch, hhorch@wuerzburg.netsurf.de, in June 1998.

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: 'hh 6/11/1998 01:45'!
emphasizeSourceTextAs: aSymbol from: tokenStart to: tokenEnd
	| runArray |
	InputSensor default commandKeyPressed
		ifTrue: [controlStream nextPutAll:
			(colorText size printString , ' ' , tokenStart printString , ' ' ,
			tokenEnd printString , ' ' , (colorText copyFrom: tokenStart to: tokenEnd) , ' ' , aSymbol) asText;
			nextPut: Character cr].
	runArray _ RunArray
					new: tokenEnd - tokenStart + 1
					withAll: (Array with: (SyntaxHighlightingTextAttribute getAttributeNamed: aSymbol)).
	runs _ runs
				copyReplaceFrom: tokenStart
				to: tokenEnd
				with: runArray! !

!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 commentStamp: 'hh 6/11/1998 03:16' prior: 0!
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: 'hh 6/11/1998 03:06'!
emphasizeScanner: scanner
	"Set the emphasis 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: 'hh 6/11/1998 03:06'!
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)! !


!Text methodsFor: 'emphasis' stamp: 'hh 6/11/1998 02:11'!
highlightSyntaxIn: aClass
	"Set emphasises of the receiver according to the syntax coloring
	 of the SyntaxHighlightParser (if it's turned on, that is)"
	| colorText |
	string size = 0 ifTrue: [^self].
	string first isLetter ifFalse: [^ self].
	SyntaxHighlightingParser doSyntaxHighlighting
		ifTrue: [colorText _ SyntaxHighlightingParser new emphasize: string inClass: aClass.
				self setString: colorText string setRuns: colorText runs]
		ifFalse: [self makeSelectorBoldIn: aClass]! !

!Text methodsFor: 'attributes' stamp: 'hh 6/11/1998 03:02'!
askIfAddCodeStyle: priorMethod req: requestor
	"Ask the user if we have a complex style (i.e. bold) for the first time.
	 Since we have automatic syntax highlighting, answer the receiver's pure string
	 if it really is different"

	| old |
	self runs coalesce.
	self unembellished ifTrue: [^ self asString].

	priorMethod ifNotNil: [old _ priorMethod getSourceFromFile].
	(old == nil or: [old unembellished])
		ifTrue: [^ self asString].
	"^ self		keep my style"! !

!Behavior methodsFor: 'accessing method dictionary' stamp: 'hh 6/11/1998 03:05'!
sourceMethodAt: selector 
	"Answer the paragraph corresponding to the source code for the 
	argument."

	^(self sourceCodeAt: selector) asText highlightSyntaxIn: self! !

!Behavior methodsFor: 'accessing method dictionary' stamp: 'hh 6/11/1998 03:05'!
sourceMethodAt: selector ifAbsent: aBlock
	"Answer the paragraph corresponding to the source code for the 
	argument."

	^ (self sourceCodeAt: selector ifAbsent: [^ aBlock value]) asText highlightSyntaxIn: self! !


!Browser methodsFor: 'message list'!
selectedMessage
	| t1 t2 t3 t4 |
	contents == nil ifFalse: [^ contents copy].
	t1 _ self selectedClassOrMetaClass.
	t2 _ self selectedMessageName.
	t3 _ t1 compiledMethodAt: t2.
	(Sensor controlKeyPressed
		or: [t3 fileIndex > 0 and: [(SourceFiles at: t3 fileIndex)
					== nil]])
		ifTrue: 
			[contents _ (t1 decompilerClass new
						decompile: t2
						in: t1
						method: t3) decompileString.
			^ contents copy].
	Sensor leftShiftDown
		ifTrue: 
			[t4 _ (t1 compilerClass new
						parse: t3 getSourceFromFile asString
						in: t1
						notifying: nil) tempNames.
			contents _ ((t1 decompilerClass new withTempNames: t4)
						decompile: t2
						in: t1
						method: t3) decompileString.
			contents _ contents asText makeSelectorBoldIn: self selectedClassOrMetaClass.
			^ contents copy].
	contents _ t1 sourceCodeAt: t2.
	contents _ contents asText highlightSyntaxIn: self selectedClassOrMetaClass.
	^ contents copy! !


!ClassDescription methodsFor: 'compiling' stamp: 'hh 6/11/1998 03:02'!
compile: text classified: category withStamp: changeStamp notifying: requestor 
	| selector priorMethod method methodNode newText |
	method _ self
		compile: text asString
		notifying: requestor
		trailer: #(0 0 0 0)
		ifFail: [^nil]
		elseSetSelectorAndNode: 
			[:sel :node | selector _ sel.
			priorMethod _ methodDict at: selector ifAbsent: [nil].
			methodNode _ node].
	self acceptsLoggingOfCompilation ifTrue:
		[newText _ (requestor ~~ nil and: [Preferences confirmFirstUseOfStyle])
			ifTrue: [text askIfAddCodeStyle: priorMethod req: requestor]
			ifFalse: [text].
		 method putSource: newText
				fromParseNode: methodNode
				class: self category: category withStamp: changeStamp 
				inFile: 2 priorMethod: priorMethod].
	self organization classify: selector under: category.
	^selector! !


!MessageSet methodsFor: 'message list' stamp: 'hh 6/11/1998 02:25'!
selectedMessage
	"Answer the source method for the currently selected message."
	| source |
	self setClassAndSelectorIn: [:class :selector | 
		source _ class sourceMethodAt: selector ifAbsent: [^ 'Missing'].
		^ source asText highlightSyntaxIn: self selectedClassOrMetaClass]! !


!LinkedMessageSet methodsFor: 'as yet unclassified' stamp: 'hh 6/11/1998 02:26'!
selectedMessage
	"Answer the source method for the currently selected message.  Allow class comment, definition, and hierarchy."

	| source |
	self setClassAndSelectorIn: [:class :selector | 
		selector first isUppercase ifFalse: [
			source _ class sourceMethodAt: selector.
			^ source asText highlightSyntaxIn: self selectedClassOrMetaClass].
		selector = #Comment ifTrue: [^ class comment].
		selector = #Definition ifTrue: [^ class definition].
		selector = #Hierarchy ifTrue: [^ class printHierarchy].
		source _ class sourceMethodAt: selector.
		^ source asText highlightSyntaxIn: self selectedClassOrMetaClass]! !

"Postscript:
Set up the initial syntax coloring scheme :"

SyntaxHighlightingTextAttribute initialize!