"
 COPYRIGHT (c) 1998 by eXept Software AG
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"



"{ Package: 'stx:libcomp' }"

Parser subclass:#SyntaxHighlighter
	instanceVariableNames:'sourceText preferences currentSuperclasses currentSubclasses
		fullSelectorCheck cachedLocalIdentifierEmphasis
		cachedLocalIdentifierColor cachedStringEmphasis cachedStringColor'
	classVariableNames:''
	poolDictionaries:''
	category:'System-Compiler'
!

!SyntaxHighlighter class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1998 by eXept Software AG
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"


!

documentation
"
    colors a method.
"


! !

!SyntaxHighlighter class methodsFor:'highlighting'!

formatClassDefinition:aString in:aClass
    "format (recolor) a class definition expression in a given class.
     Return the text containing font changes and color information."

    ^ self formatExpression:aString in:aClass
!

formatExpression:aString in:aClass
    "format (recolor) an expression in a given class.
     Return the text containing font changes and color information."

    |parser tree text endPos|

    aString isNil ifTrue:[^ nil].

    parser := self for:(ReadStream on:aString string) in:aClass.
    parser ignoreErrors:true.
    parser ignoreWarnings:true.
    parser sourceText:(text := aString string asText).
    "/ use an array here - this can be changed much faster using #at:put:
    text emphasisCollection:(Array new:aString size).

    parser nextToken.
    tree := parser expression.
    "/ now, convert the emphasis-array to a runArray
    text emphasisCollection:(text emphasis asRunArray).

    tree == #Error ifTrue:[
        "/ mhmh - which is better ...
        "/ alternative1: color rest after error in red
"/        text 
"/            emphasizeFrom:(parser sourceStream position) 
"/            to:text size 
"/            with:(#color->Color red).


        "/ alternative2: take original emphasis for rest

        endPos := parser sourceStream position1Based.
        endPos >= text size ifTrue:[
            ^ text
        ].
        ^ (text copyTo:endPos) , (aString copyFrom:(endPos+1))

        "/ alternative3: no emphasis for rest.

"/        ^ text "/ aString
    ].
    ^ text

    "
     self
        formatExpression:'(1 + 2) max:5' 
        in:UndefinedObject
    "

    "Modified: / 7.4.1998 / 09:57:19 / cg"
    "Created: / 9.4.1998 / 16:57:16 / cg"
!

formatMethod:aString in:aClass
    "format (recolor) a method in a given class.
     Return the text containing font changes and color information."

    ^ self formatMethod:aString in:aClass using:nil

    "
     self
        formatMethod:'foo 
    ^ self bar:''hello''.

    ' , (Character doubleQuote asString) , 'some comment' , (Character doubleQuote asString) , '
'
        in:UndefinedObject
    "

    "Modified: / 23.10.1998 / 22:48:45 / cg"
!

formatMethod:aString in:aClass using:preferencesOrNil
    "format (recolor) a method in a given class.
     Return the text containing font changes and color information."

    |highlighter tree text endPos eColor|

    aString isNil ifTrue:[^ nil].

    Error handle:[:ex |
        ex signal isHandled ifTrue:[
            ex reject.    
        ].
        ('SyntaxHighlighter [info]: error during highlight: ' , ex description) infoPrintCR.
        "/ ex suspendedContext fullPrintAll.
        ^ aString
    ] do:[
        highlighter := self for:(ReadStream on:aString string) in:aClass.
        preferencesOrNil notNil ifTrue:[highlighter preferences:preferencesOrNil].
        "/ highlighter ignoreErrors:true.
        highlighter ignoreWarnings:true.
        highlighter sourceText:(text := aString string asText).
        "/ use an array here - this can be changed much faster using #at:put:
        text emphasisCollection:(Array new:aString size).

        tree := highlighter parseMethod.
        "/ now, convert the emphasis-array to a runArray
        text emphasisCollection:(text emphasis asRunArray).

        tree == #Error ifTrue:[
            eColor := UserPreferences current errorColor.
            eColor notNil ifTrue:[
                "/ mhmh - which is better ...
                "/ alternative1: color rest after error in red
                text 
                    emphasizeFrom:(highlighter sourceStream position1Based) 
                    to:text size 
                    with:(#color->eColor).
            ] ifFalse:[
                "/ alternative2: take original emphasis for rest

                endPos := highlighter sourceStream position1Based.
                endPos >= text size ifTrue:[
                    ^ text
                ].
                ^ (text copyTo:endPos) , (aString copyFrom:(endPos+1))
            ].
            "/ alternative3: no emphasis for rest.
        ].
        ^ text
    ]
    "
     self
        formatMethod:'foo 
    ^ self bar:''hello''.

    ' , (Character doubleQuote asString) , 'some comment' , (Character doubleQuote asString) , '
'
        in:UndefinedObject
    "

    "Modified: / 22-08-2006 / 13:32:04 / cg"
! !

!SyntaxHighlighter methodsFor:'accessing'!

preferences:something
    preferences := something.
!

sourceText
    "return the value of the instance variable 'sourceText' (automatically generated)"

    ^ sourceText

    "Created: / 31.3.1998 / 11:49:05 / cg"
!

sourceText:something
    "set the value of the instance variable 'sourceText' (automatically generated)"

    sourceText := something.

    "Created: / 31.3.1998 / 11:49:05 / cg"
! !

!SyntaxHighlighter methodsFor:'error handling'!

parseError:aMessage position:position to:endPos
"/ Transcript showCR:aMessage.
    super parseError:aMessage position:position to:endPos.

    self 
        markFrom:position to:endPos 
        withEmphasis:nil color:UserPreferences current errorColor
!

showErrorMessage:aMessage position:pos
"/ Transcript showCR:aMessage.
    super showErrorMessage:aMessage position:pos.

    self 
        markFrom:pos to:nil 
        withEmphasis:nil color:UserPreferences current errorColor
!

syntaxError:aMessage position:position to:endPos
"/ Transcript showCR:aMessage.
    super syntaxError:aMessage position:position to:endPos.

    self 
        markFrom:position to:endPos 
        withEmphasis:nil color:UserPreferences current errorColor
!

warning:msg position:pos1 to:pos2
"/    self markUnknownIdentifierFrom:pos1 to:pos2

"/    self
"/        markFrom:pos1 to:pos2 
"/        withEmphasis:nil color:UserPreferences current errorColor

    "Modified: / 25.9.1999 / 18:42:30 / cg"
! !

!SyntaxHighlighter methodsFor:'initialization'!

initialize
    super initialize.

    foldConstants := false.
"/    parserFlags allowDollarInIdentifier:true.

    preferences := UserPreferences current.

    fullSelectorCheck := preferences fullSelectorCheck.

    "Created: / 31.3.1998 / 15:12:55 / cg"
    "Modified: / 5.1.1980 / 00:44:03 / cg"
! !

!SyntaxHighlighter methodsFor:'misc'!

controlFlowSelectors
    ^ #(
        ifTrue:
        ifFalse:
        ifTrue:ifFalse:
        ifFalse:ifTrue:

        whileTrue:
        whileFalse:

        to:do:
        to:by:do:

        loop
        whileTrue
        whileFalse
        doWhile:
        doUntil:
    )

    "Created: / 08-09-2006 / 15:56:47 / cg"
!

defineAsUndeclaredVariable:aName
    "redefined to NOT declare undefined vars"

    ^ VariableNode globalNamed:aName

    "Modified: / 19.10.1998 / 19:38:12 / cg"
!

isSyntaxHighlighter
    ^ true

!

plausibilityCheck:aNode
    "redefined to NOT do checks"

    ^ nil

    "Modified: / 19.10.1998 / 19:38:12 / cg"
    "Created: / 19.10.1998 / 19:57:18 / cg"
! !

!SyntaxHighlighter methodsFor:'syntax detection'!

markArgumentIdentifierFrom:pos1 to:pos2
    self 
        markFrom:pos1 to:pos2 
        withEmphasis:(preferences argumentIdentifierEmphasis) 
        color:(preferences argumentIdentifierColor)

    "Modified: / 31.3.1998 / 18:01:27 / cg"
!

markBadIdentifierFrom:pos1 to:pos2
    self 
        markFrom:pos1 to:pos2 
        withEmphasis:(preferences badIdentifierEmphasis) 
        color:(preferences badIdentifierColor)
!

markBooleanConstantFrom:pos1 to:pos2
    self 
        markFrom:pos1 to:pos2 
        withEmphasis:(preferences booleanConstantEmphasis) 
        color:(preferences booleanConstantColor)

    "Created: / 31.3.1998 / 18:09:01 / cg"
    "Modified: / 31.3.1998 / 19:36:44 / cg"
!

markBracketAt:pos
    self 
        markFrom:pos to:pos 
        withEmphasis:(preferences bracketEmphasis) 
        color:(preferences bracketColor)

    "Created: / 31.3.1998 / 18:09:01 / cg"
    "Modified: / 31.3.1998 / 19:36:44 / cg"
!

markClassVariableIdentifierFrom:pos1 to:pos2
    self 
        markFrom:pos1 to:pos2 
        withEmphasis:(preferences classVariableIdentifierEmphasis) 
        color:(preferences classVariableIdentifierColor)

    "Modified: / 31.3.1998 / 18:02:14 / cg"
!

markCommentFrom:pos1 to:pos2
    self 
        markFrom:pos1 to:pos2 
        withEmphasis:(preferences commentEmphasis) 
        color:(preferences commentColor)

    "
     UserPreferences current commentEmphasis
    "
    "Modified: / 31.3.1998 / 18:01:55 / cg"
!

markConstantFrom:pos1 to:pos2
    self 
        markFrom:pos1 to:pos2 
        withEmphasis:(preferences constantEmphasis) 
        color:(preferences constantColor)

    "Modified: / 31.3.1998 / 18:01:44 / cg"
    "Created: / 31.3.1998 / 18:09:22 / cg"
!

markFrom:pos1 to:pos2 withEmphasis:fontEmp color:clrIn
    |e p2 clr|

    clr := clrIn onDevice:Screen current.

    clr = Color black ifTrue:[
        e := fontEmp
    ] ifFalse:[
        fontEmp isNil ifTrue:[
            e := (#color->clr)
        ] ifFalse:[
            e := Text addEmphasis:fontEmp to:(#color->clr).
        ]
    ].
    (p2 := pos2) isNil ifTrue:[
        p2 := sourceText size
    ] ifFalse:[
        p2 := p2 min:sourceText size
    ].
    sourceText emphasizeFrom:pos1 to:p2 with:e

    "Created: / 31.3.1998 / 13:26:53 / cg"
    "Modified: / 1.4.1998 / 12:51:56 / cg"
!

markGlobalClassIdentifierFrom:pos1 to:pos2
    self 
        markFrom:pos1 to:pos2 
        withEmphasis:(preferences globalClassIdentifierEmphasis) 
        color:(preferences globalClassIdentifierColor)

    "Modified: / 31.3.1998 / 18:02:14 / cg"
    "Created: / 4.3.1999 / 12:53:02 / cg"
!

markGlobalIdentifierFrom:pos1 to:pos2
    self 
        markFrom:pos1 to:pos2 
        withEmphasis:(preferences globalIdentifierEmphasis) 
        color:(preferences globalIdentifierColor)

    "Modified: / 31.3.1998 / 18:02:14 / cg"
!

markHereFrom:pos1 to:pos2
    self 
        markFrom:pos1 to:pos2 
        withEmphasis:(preferences hereEmphasis) 
        color:(preferences hereColor)

    "Modified: / 31.3.1998 / 18:02:25 / cg"
!

markIdentifierFrom:pos1 to:pos2
    self 
        markFrom:pos1 to:pos2 
        withEmphasis:(preferences identifierEmphasis) 
        color:(preferences identifierColor)

    "Modified: / 31.3.1998 / 18:02:39 / cg"
    "Created: / 31.3.1998 / 18:04:56 / cg"
!

markInstVarIdentifierFrom:pos1 to:pos2
    self 
        markFrom:pos1 to:pos2 
        withEmphasis:(preferences instVarIdentifierEmphasis)    
        color:(preferences instVarIdentifierColor)

    "Created: / 16.4.1998 / 18:35:40 / cg"
    "Modified: / 16.4.1998 / 18:37:30 / cg"
!

markLocalIdentifierFrom:pos1 to:pos2
    cachedLocalIdentifierEmphasis isNil ifTrue:[
        cachedLocalIdentifierEmphasis := preferences localIdentifierEmphasis.
        cachedLocalIdentifierColor := preferences localIdentifierColor.
    ].
    self 
        markFrom:pos1 to:pos2 
        withEmphasis:cachedLocalIdentifierEmphasis 
        color:cachedLocalIdentifierColor

    "Modified: / 31.3.1998 / 18:02:39 / cg"
!

markMethodSelectorFrom:pos1 to:pos2
    self 
        markFrom:pos1 to:pos2 
        withEmphasis:(preferences methodSelectorEmphasis) 
        color:(preferences methodSelectorColor)

    "Modified: / 31.3.1998 / 18:02:52 / cg"
!

markNumberConstantFrom:pos1 to:pos2
    self 
        markFrom:pos1 to:pos2 
        withEmphasis:(preferences numberConstantEmphasis) 
        color:(preferences numberConstantColor)

    "Modified: / 31.3.1998 / 18:01:44 / cg"
    "Created: / 31.3.1998 / 18:09:22 / cg"
!

markParenthesisAt:pos
    |colors clr em|

    preferences emphasizeParenthesisLevel ifFalse:[^ self].

    colors := Array 
                with:(Color black)
                with:(Color blue)
                with:(Color green blendWith:(Color grey:30))
                with:(Color red blendWith:(Color grey:30))
                with:(Color yellow darkened).
                        
    clr := colors at:((parenthesisLevel-1) \\ colors size + 1).
    em := #normal.
    parenthesisLevel > 1 ifTrue:[
        em := #bold.
    ].
    self 
        markFrom:pos to:pos 
        withEmphasis:em 
        color:clr
!

markPoolVariableIdentifierFrom:pos1 to:pos2
    self 
        markFrom:pos1 to:pos2 
        withEmphasis:(preferences poolVariableIdentifierEmphasis) 
        color:(preferences poolVariableIdentifierColor)
!

markReturnAt:pos
    self 
        markFrom:pos to:pos 
        withEmphasis:(preferences returnEmphasis) 
        color:(preferences returnColor)

    "Modified: / 31.3.1998 / 19:36:44 / cg"
    "Created: / 5.1.1980 / 00:44:27 / cg"
!

markSelector:selectorString from:pos1 to:pos2 receiverNode:aReceiverNode
    |fg selectorSymbol check ok rec em|

"/ uncommenting the code below
"/ will suppress highlighting of common selectors ...
"/
"/    (#(
"/        'ifTrue:' 
"/        'ifFalse:'
"/        'not'
"/        'and:'
"/        'or:'
"/        '='
"/        '=='
"/        '~='
"/        '~~'
"/    ) includes:sel) ifTrue:[
"/        ^ self
"/    ].

    fg := preferences selectorColor.
    em := preferences selectorEmphasis.
    selectorSymbol := selectorString asSymbolIfInterned.
    selectorSymbol isNil ifTrue:[
        em := preferences unimplementedSelectorEmphasis.
        fg := preferences unimplementedSelectorColor.
    ] ifFalse:[
        ok := true.

        fullSelectorCheck == true ifTrue:[

            check := [:cls | (cls includesSelector:selectorSymbol)
                             or:[cls class includesSelector:selectorSymbol]].

            ok := false.

            "/ limit search if possible
            (classToCompileFor notNil
             and:[aReceiverNode isSelf or:[aReceiverNode isSuper]]) ifTrue:[
                currentSuperclasses isNil ifTrue:[
                    currentSuperclasses := classToCompileFor withAllSuperclasses.
                ].
                ok := currentSuperclasses contains:check.
                (ok not and:[aReceiverNode isSelf]) ifTrue:[
                    currentSubclasses isNil ifTrue:[
                        currentSubclasses := classToCompileFor allSubclasses.
                    ].
                    ok := currentSubclasses contains:check.
                ].
            ] ifFalse:[
                aReceiverNode isConstant ifTrue:[
                    ok := aReceiverNode evaluate class withAllSuperclasses contains:check.
                ] ifFalse:[
                    (aReceiverNode isGlobal 
                    and:[(rec := aReceiverNode evaluate) isBehavior]) ifTrue:[
                        ok := rec class withAllSuperclasses contains:check.
                    ] ifFalse:[
                        ok := Smalltalk allClasses contains:check
                    ]
                ]
            ].
        ].
        ok ifFalse:[
            em := preferences unimplementedSelectorEmphasis.
            fg := preferences unimplementedSelectorColor.
        ] ifTrue:[
            (self controlFlowSelectors includesIdentical:selectorSymbol) ifTrue:[
                em := preferences controlFlowSelectorEmphasis.
                fg := preferences controlFlowSelectorColor.
            ].
        ].
    ].
    self
        markFrom:pos1 to:pos2 
        withEmphasis:em 
        color:fg

    "Modified: / 08-09-2006 / 15:57:02 / cg"
!

markSelfFrom:pos1 to:pos2
    self 
        markFrom:pos1 to:pos2 
        withEmphasis:(preferences selfEmphasis) 
        color:(preferences selfColor)

    "Modified: / 31.3.1998 / 18:03:10 / cg"
!

markStringFrom:pos1 to:pos2
    cachedStringEmphasis isNil ifTrue:[
        cachedStringEmphasis := preferences stringEmphasis.
        cachedStringColor := preferences stringColor.
    ].
    self 
        markFrom:pos1 to:pos2 
        withEmphasis:cachedStringEmphasis 
        color:cachedStringColor

    "Modified: / 31.3.1998 / 18:03:18 / cg"
!

markSuperFrom:pos1 to:pos2
    self 
        markFrom:pos1 to:pos2 
        withEmphasis:(preferences superEmphasis) 
        color:(preferences superColor)

    "Modified: / 31.3.1998 / 18:03:26 / cg"
!

markSymbolFrom:pos1 to:pos2
    self 
        markFrom:pos1 to:pos2 
        withEmphasis:(preferences symbolEmphasis) 
        color:(preferences symbolColor)

    "Created: / 1.4.1998 / 12:56:47 / cg"
    "Modified: / 1.4.1998 / 12:58:00 / cg"
!

markThisContextFrom:pos1 to:pos2
    self 
        markFrom:pos1 to:pos2 
        withEmphasis:(preferences thisContextEmphasis) 
        color:(preferences thisContextColor)

    "Modified: / 31.3.1998 / 18:03:36 / cg"
!

markUnknownIdentifierFrom:pos1 to:pos2
    self 
        markFrom:pos1 to:pos2 
        withEmphasis:(preferences unknownIdentifierEmphasis) 
        color:(preferences unknownIdentifierColor)

    "Created: / 31.3.1998 / 19:09:26 / cg"
    "Modified: / 31.3.1998 / 19:10:30 / cg"
!

markVariable:v
    "support for syntaxColoring"

    |pos endPos|

    pos := tokenPosition.
    endPos := pos+tokenName size-1.
    self markVariable:v from:pos to:endPos

    "Modified: / 16.4.1998 / 18:49:51 / cg"
!

markVariable:v from:pos to:endPos
    "support for syntaxColoring"

    |type globalValue nameSym|

    type := v type.
    (type == #BlockArg
    or:[type == #MethodArg]) ifTrue:[
        self markArgumentIdentifierFrom:pos to:endPos.
        ^ self
    ].
    (type == #BlockVariable
    or:[type == #MethodVariable]) ifTrue:[
        self markLocalIdentifierFrom:pos to:endPos.
        ^ self
    ].
    (type == #GlobalVariable) ifTrue:[
        nameSym := v name asSymbolIfInterned.
        nameSym notNil ifTrue:[
            globalValue := Smalltalk at:nameSym ifAbsent:nil.
        ].
        globalValue isBehavior ifTrue:[
            self markGlobalClassIdentifierFrom:pos to:endPos.
        ] ifFalse:[
            self markGlobalIdentifierFrom:pos to:endPos.
        ].
        ^ self
    ].
    (type == #PoolVariable) ifTrue:[
        self markPoolVariableIdentifierFrom:pos to:endPos.
        ^ self
    ].
    (type == #ClassVariable) ifTrue:[
        self markClassVariableIdentifierFrom:pos to:endPos.
        ^ self
    ].
    (type == #InstanceVariable) ifTrue:[
        self markInstVarIdentifierFrom:pos to:endPos.
        ^ self
    ].

    self markIdentifierFrom:pos to:endPos.

    "Created: / 16.4.1998 / 18:49:34 / cg"
    "Modified: / 4.3.1999 / 12:56:13 / cg"
! !

!SyntaxHighlighter class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libcomp/SyntaxHighlighter.st,v 1.54 2006-09-08 14:14:40 cg Exp $'
! !