"

 COPYRIGHT (c) 2006 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:libtool' }"

SyntaxHighlighter subclass:#SyntaxHighlighter2

	instanceVariableNames:'elements lastSelectorElement lastVariableElement'

	classVariableNames:''

	poolDictionaries:''

	category:'Interface-CodeView-Syntax'

!

!SyntaxHighlighter2 class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 2006 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.

"

! !

!SyntaxHighlighter2 class methodsFor:'highlighting'!

formatClassDefinition:aString in:aClass elementsInto: elements

    "format (recolor) a class definition expression in a given class.

     Return the text containing font changes and color information."

    ^ self formatExpression:aString in:aClass elementsInto: elements

    "Created: / 10-04-2011 / 18:18:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

formatExpression:aString in:aClass elementsInto: elements

    "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 elements: elements.

    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"statementList.

    "/ 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

    "

    "Created: / 25-07-2010 / 08:56:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 25-07-2010 / 10:57:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

formatMethod:aString in:aClass using:preferencesOrNil elementsInto: elements

    "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.    

        ].

        (self parseErrorSignal handles:ex) ifFalse:[

            "Parse error may happen when re-formatting incomplete code while editing"

            ('SyntaxHighlighter [info]: error during highlight: ' , ex description) infoPrintCR.

            "/ ex suspendedContext fullPrintAll.

        ].

        ^ aString

    ] do:[

        highlighter := self for:(ReadStream on:aString string) in:aClass.

        highlighter elements: elements.

        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:[

                    ^ Array with: text with: highlighter elements

                ].

                ^ ((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"

    "Created: / 25-07-2010 / 08:56:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!SyntaxHighlighter2 methodsFor:'accessing'!

elements

    ^ elements

!

elements:something

    elements := something.

! !

!SyntaxHighlighter2 methodsFor:'initialization'!

initialize

    super initialize.

    elements := SortedCollection new.

    lastVariableElement := Dictionary new.

    "Created: / 14-02-2010 / 13:08:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 25-06-2010 / 13:04:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!SyntaxHighlighter2 methodsFor:'parsing-expressions'!

binaryExpressionFor:receiverArg

    "parse a binary-expression; return a node-tree, nil or #Error"

    |receiver expr arg sel pos1 pos2 lno note|

    receiver := receiverArg.

    (receiver == #Error) ifTrue:[^ #Error].

    "special kludge: since Scanner cannot know if -digit is a binary

     expression or a negative constant, handle cases here"

    [(tokenType == #BinaryOperator) 

     or:[(tokenType == $|)

     or:[(tokenType == $^ and:[parserFlags allowCaretAsBinop])

         or:[((tokenType == #Integer) or:[tokenType == #Float])

             and:[tokenValue < 0]]]]

    ] whileTrue:[

        "/ kludge alarm: in a function-call argList, #, is not a binarySelector

        inFunctionCallArgument == true ifTrue:[

            ((tokenType == #BinaryOperator) and:[tokenName = ',']) ifTrue:[

                ^ receiver

            ].

        ].

        pos1 := tokenPosition.

        lno := tokenLineNr.

        "/ kludge alarm: bar, caret and minus are not scanned as binop

        (tokenType == $|) ifTrue:[

            sel := '|'.

            sel := self selectorCheck:sel for:receiver position:tokenPosition to:tokenPosition.

            self nextToken.

        ] ifFalse:[

            (tokenType == $^) ifTrue:[

                sel := '^'.

                sel := self selectorCheck:sel for:receiver position:tokenPosition to:tokenPosition.

                self nextToken.

            ] ifFalse:[

                (tokenType == #BinaryOperator) ifTrue:[

                    sel := tokenName.

                    sel := self selectorCheck:sel for:receiver position:tokenPosition to:(tokenPosition + tokenName size - 1).

                    self nextToken

                ] ifFalse:[

                    sel := '-'.

                    token := tokenValue := tokenValue negated.

                    tokenPosition := tokenPosition + 1. "/ to skip the sign

                ]

            ].

        ].

        pos2 := pos1 + sel size - 1.

        self markSelector:sel from:pos1 to:pos2 receiverNode:receiver.

        lastSelectorElement := nil.

        arg := self unaryExpression.

        (arg == #Error) ifTrue:[^ #Error].

        expr := BinaryNode receiver:receiver selector:sel arg:arg fold:foldConstants.

        expr isErrorNode ifTrue:[

            self parseError:(expr errorString) position:pos1 to:tokenPosition.

            errorFlag := false. "ok, user wants it - so he'll get it"

            expr := BinaryNode receiver:receiver selector:sel arg:arg fold:nil.

        ].

        expr lineNumber:lno.

        expr selectorPosition:pos1.

        (ignoreErrors or:[ignoreWarnings]) ifFalse:[

            note := self plausibilityCheck:expr.

            note notNil ifTrue:[

                self warning:note position:pos1 to:pos2

            ].

        ].

        parseForCode ifFalse:[

            self rememberSelectorUsed:sel receiver:receiver

        ].

        receiver := expr.   "/ for next message

    ].

    ^ receiver

    "Modified: / 09-01-1998 / 19:05:18 / stefan"

    "Modified: / 19-01-2000 / 16:22:04 / cg"

    "Modified: / 14-02-2010 / 17:54:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

expression

    "parse a cascade-expression; return a node-tree, nil or #Error.

     expression ::= keywordExpression

                    | keywordExpression cascade

     cascade ::= ';' expressionSendPart

                 | cascade ';' expressionSendPart

     expressionSendPart ::= { KEYWORD binaryExpression }

                            | BINARYOPERATOR unaryExpression

                            | IDENTIFIER

    "

    |receiver arg sel args pos pos2 lno tokenEnd realReceiver positions|

    pos := tokenPosition.

    receiver := self keywordExpression.

    (receiver == #Error) ifTrue:[^ #Error].

    (tokenType == $;) ifTrue:[

        receiver isMessage ifFalse:[

            self syntaxError:'left side of cascade must be a message expression'

                    position:pos to:tokenPosition.

            realReceiver := receiver. "/ only to allow continuing.

        ] ifTrue:[

            realReceiver := receiver receiver.

        ].

        [tokenType == $;] whileTrue:[

            self nextToken.

            (tokenType == #Identifier) ifTrue:[

                tokenEnd := tokenPosition + tokenName size - 1.

                self markSelector:tokenName from:tokenPosition to:tokenEnd receiverNode:realReceiver.

                sel := tokenName.

                sel := self selectorCheck:tokenName for:realReceiver position:tokenPosition to:tokenEnd.

                receiver := CascadeNode receiver:receiver selector:sel.

                receiver lineNumber:tokenLineNr.

                parseForCode ifFalse:[

                    self rememberSelectorUsed:sel

                ].

                self nextToken.

            ] ifFalse:[

                (tokenType == #BinaryOperator) ifTrue:[

                    tokenEnd := tokenPosition + tokenName size - 1.

                    self markSelector:tokenName from:tokenPosition to:tokenEnd receiverNode:realReceiver.

                    lastSelectorElement := nil.

                    sel := tokenName.

                    sel := self selectorCheck:tokenName for:realReceiver position:tokenPosition to:tokenEnd.

                    lno := tokenLineNr. 

                    self nextToken.

                    arg := self unaryExpression.

                    (arg == #Error) ifTrue:[^ #Error].

                    receiver := CascadeNode receiver:receiver selector:sel arg:arg.

                    receiver lineNumber:lno.

                    parseForCode ifFalse:[

                        self rememberSelectorUsed:sel

                    ].

                ] ifFalse:[

                    (tokenType == #Keyword) ifTrue:[

                        tokenEnd := tokenPosition + tokenName size - 1.

                        positions := OrderedCollection with:(tokenPosition to:tokenEnd).

                        pos := tokenPosition.

                        pos2 := tokenEnd.

                        lno := tokenLineNr. 

                        sel := tokenName.

                        self nextToken.

                        arg := self binaryExpression.

                        (arg == #Error) ifTrue:[^ #Error].

                        args := Array with:arg.

                        [tokenType == #Keyword] whileTrue:[

                            tokenEnd := tokenPosition + tokenName size - 1.

                            positions add:(tokenPosition to:tokenEnd).

                            sel := sel , tokenName.

                            self nextToken.

                            arg := self binaryExpression.

                            (arg == #Error) ifTrue:[^ #Error].

                            args := args copyWith:arg.

                            pos2 := tokenEnd

                        ].

                        positions do:[:p |

                            self markSelector:sel from:p start to:p stop receiverNode:realReceiver.

                        ].

                        lastSelectorElement := nil.                                

                        sel := self selectorCheck:sel for:realReceiver position:pos to:pos2.

                        receiver := CascadeNode receiver:receiver selector:sel args:args.

                        receiver lineNumber:lno.

                        parseForCode ifFalse:[

                            self rememberSelectorUsed:sel

                        ].

                    ] ifFalse:[

                        (tokenType == #Error) ifTrue:[^ #Error].

                        self syntaxError:('invalid cascade; ' , tokenType printString , ' unexpected')

                                position:tokenPosition to:source position1Based - 1.

                        ^ #Error

                    ]

                ]

            ]

        ].

        "obscure (unspecified ?) if selector follows; Question:

        is

                'expr sel1; sel2 sel3'

        to be parsed as: 

                (t := expr.

                 t sel1.

                 t sel2) sel3

         or:

                (t := expr.

                 t sel1.

                 t sel2 sel3)

        "

        ((tokenType == #Identifier) 

         or:[(tokenType == #BinaryOperator)

             or:[tokenType == #Keyword]]) ifTrue:[

            self syntaxError:'ambigous cascade - please group using (...)'

                    position:tokenPosition to:source position1Based - 1.

            ^ #Error

"/            self warning: "syntaxError:" 'possibly ambigous cascade - please group using (...)'

"/                    position:tokenPosition to:source position - 1.

"/            tokenType == #Identifier ifTrue:[

"/                ^ self unaryExpressionFor:receiver

"/            ].

"/            tokenType == #BinaryOperator ifTrue:[

"/                ^ self binaryExpressionFor:receiver

"/            ].

"/            ^ self keywordExpressionFor:receiver

        ]

    ].

    ^ receiver

    "Modified: / 19-01-2000 / 16:22:16 / cg"

    "Modified: / 14-02-2010 / 17:58:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

keywordExpressionFor:receiverArg

    "parse a keyword-expression; return a node-tree, nil or #Error.

     keywordExpression ::= binaryexpression

                           | { KEYWORD-PART binaryExpression }

    "

    |expr receiver sel arg args posR1 posR2 pos1 pos2 lno note positions constVal|

    receiver := receiverArg.

    posR1 := tokenPosition.

    (tokenType == #Keyword) ifFalse:[^ receiver].

    pos1 := posR2 := tokenPosition.

    pos2 := tokenPosition + tokenName size - 1.

    positions := OrderedCollection with:(pos1 to:pos2).

    sel := tokenName.

    lno := tokenLineNr.

    self nextToken.

    arg := self binaryExpression.

    (arg == #Error) ifTrue:[^ #Error].

    args := Array with:arg.

    [tokenType == #Keyword] whileTrue:[

        sel := sel , tokenName.

        pos2 := tokenPosition + tokenName size - 1.

        positions add:(tokenPosition to:pos2).

        self nextToken.

        arg := self binaryExpression.

        (arg == #Error) ifTrue:[^ #Error].

        args := args copyWith:arg.

    ].

    positions do:[:p |

        self markSelector:sel from:p start to:p stop receiverNode:receiver.

    ].

    lastSelectorElement := nil.

    sel := self selectorCheck:sel for:receiver positions:positions.

    ignoreWarnings ifFalse:[

        (Class definitionSelectors includes:sel) ifTrue:[

            (receiver isVariable and:[receiver isUndeclared]) ifTrue:[

                "this is not an error - the undefined class may be loaded after this code!!"

                self warning:('as yet undefined superclass: ' , receiver name) position:pos1 to:pos2.

            ].

        ].

    ].

    expr := MessageNode receiver:receiver selector:sel args:args fold:foldConstants.

    expr isErrorNode ifTrue:[

        self parseError:(expr errorString) position:pos1 to:pos2.

        errorFlag := false. "ok, user wants it - so he'll get it"

        expr := MessageNode receiver:receiver selector:sel args:args fold:nil.

    ].

    expr lineNumber:lno.

    (ignoreErrors or:[ignoreWarnings]) ifFalse:[

        note := self plausibilityCheck:expr.

        note notNil ifTrue:[

            self warning:note position:pos1 to:pos2

        ].

    ].

    parseForCode ifFalse:[

        self rememberSelectorUsed:sel receiver:receiver

    ].

"/        (contextToEvaluateIn isNil and:[selfValue isNil]) ifTrue:[    "/ do not check this for doits

"/            receiver isSuper ifTrue:[

"/                sel ~= selector ifTrue:[

"/                    self warnCommonMistake:'possible bad super message (selector should be same as in current method) ?'

"/                                  position:posR1 to:posR2-1

"/                ].

"/            ].

"/        ].

"/

    (sel = #ifTrue: or:[sel = #ifFalse: or:[sel = #ifTrue:ifFalse: or:[sel = #ifFalse:ifTrue:]]]) ifTrue:[

        (expr receiver withConstantValueDo:[:val | constVal := val]) ifTrue:[

            |indexOfArgNotExecuted|

            "/ receiver evaluates to a constant

            constVal == true ifTrue:[

                (sel startsWith: #ifFalse:) ifTrue:[

                    indexOfArgNotExecuted := 1.

                ] ifFalse:[

                    indexOfArgNotExecuted := 2.

                ]

            ].

            constVal == false ifTrue:[

                (sel startsWith: #ifTrue:) ifTrue:[

                    indexOfArgNotExecuted := 1.

                ] ifFalse:[

                    indexOfArgNotExecuted := 2.

                ]

            ].

            indexOfArgNotExecuted == 2 ifTrue:[

                args size == 1 ifTrue:[ indexOfArgNotExecuted := nil]

            ].

            indexOfArgNotExecuted notNil ifTrue:[

                |argIsNotExecuted|

                "/ self warning:'receiver is constant; arg',indexOfArgNotExecuted printString,' is never executed' position:pos1 to:tokenPosition.

                argIsNotExecuted := expr args at:indexOfArgNotExecuted.

                argIsNotExecuted isBlockNode ifTrue:[

                    self markCommentFrom:argIsNotExecuted startPosition to:argIsNotExecuted endPosition.

                ].

            ].

        ].

    ].

    (ignoreErrors or:[ignoreWarnings]) ifFalse:[

        (sel = #and: or:[sel = #or:]) ifTrue:[

            expr arg1 isBlock ifFalse:[

                (expr arg1 isVariable

                and:[ (expr arg1 name asLowercase includesString:'block')]) ifFalse:[