"{ Encoding: utf8 }"

"

 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:libcomp' }"

"{ NameSpace: Smalltalk }"

Parser subclass:#AbstractSyntaxHighlighter

	instanceVariableNames:'method sourceText preferences fullSelectorCheck commentColor

		commentEmphasis commentFont constantColor constantEmphasis'

	classVariableNames:''

	poolDictionaries:''

	category:'System-Compiler'

!

!AbstractSyntaxHighlighter 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.

"

!

documentation

"

    common superclass for (smalltalk-) syntax highlighting.

    This will parse the source code and update the local copy of the

    sourceText (in that instvar) by changing emphasis and color,

    as syntax elements are encountered.

    This is done by redefining appropriate markXXX methods, which are

    called by the parser whenever an interesting syntactic construct is encountered.

    These methods are no-ops in the Parser class, but redefined here to update

    the colorization of sourceText.

    Caveat:

        used to be a smalltalk syntax highlighter and therefore (wrongly) subclassed Parser.

        However, over time, much functionality was added, which is of use for other languages also

        and this class will therefore be changed to use composition and have parsing delegated.

        to be independent of the language and to not inherit stuff, which is not needed.

"

! !

!AbstractSyntaxHighlighter class methodsFor:'api 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

!

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

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

!

formatExpression:aString in:aClass

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

     Return the text containing font changes and color information."

    |parser|

    aString isNil ifTrue:[^ nil].

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

    ^ parser formatExpression:aString in:aClass

    "

     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

    <resource: #obsolete>

    "format (recolor) a method in a given class.

     Return the text containing font changes and color information."

    self obsoleteMethodWarning:'use #formatMethodSource:in:'.

    ^ self formatMethod:nil source:aString in:aClass using:nil

    "

     self

	formatMethod:'foo

    ^ self bar:''hello''.

    ' , (Character doubleQuote asString) , 'some comment' , (Character doubleQuote asString) , '

'

	in:UndefinedObject

    "

    "Modified: / 28-04-2010 / 13:03:04 / cg"

!

formatMethod:aString in:aClass using:preferencesOrNil

    <resource: #obsolete>

    "format (recolor) a method in a given class.

     Return the text containing font changes and color information."

    self obsoleteMethodWarning:'use #formatMethodSource:in:using:'.

    ^ self formatMethod:nil source:aString in:aClass using:preferencesOrNil

    "Modified: / 28-04-2010 / 13:03:15 / cg"

!

formatMethod:methodOrNil source:aString in:aClass

    "format (recolor) a method in a given class.

     Return the text containing font changes and color information."

    ^ self formatMethod:methodOrNil source:aString in:aClass using:nil

    "

     self

	formatMethod:'foo

    ^ self bar:''hello''.

    ' , (Character doubleQuote asString) , 'some comment' , (Character doubleQuote asString) , '

'

	in:UndefinedObject

    "

    "Created: / 28-04-2010 / 13:44:24 / cg"

!

formatMethod:methodOrNil source:aString in:aClass using:preferencesOrNil

    "format (recolor) a method in a given class.

     Return the text containing font changes and color information."

    aString isNil ifTrue:[^ nil].

    ^ (self for:aString in:aClass)

        formatMethod:methodOrNil source:aString in:aClass using:preferencesOrNil

    "

     self

        formatMethod:'foo

    ^ self bar:''hello''.

    ' , (Character doubleQuote asString) , 'some comment' , (Character doubleQuote asString) , '

'

        in:UndefinedObject

    "

    "Created: / 28-04-2010 / 13:01:42 / cg"

    "Modified: / 05-07-2011 / 11:22:20 / cg"

    "Modified: / 22-12-2018 / 09:01:10 / Claus Gittinger"

!

formatMethodSource:aString in:aClass

    "format (recolor) a method in a given class.

     Return the text containing font changes and color information."

    ^ self formatMethod:nil source:aString in:aClass using:nil

    "

     self

	formatMethod:'foo

    ^ self bar:''hello''.

    ' , (Character doubleQuote asString) , 'some comment' , (Character doubleQuote asString) , '

'

	in:UndefinedObject

    "

    "Created: / 28-04-2010 / 12:58:13 / cg"

!

formatMethodSource:aString in:aClass using:preferencesOrNil

    "format (recolor) a method in a given class.

     Return the text containing font changes and color information."

    ^ self formatMethod:nil source:aString in:aClass using:preferencesOrNil

    "Modified: / 28-04-2010 / 13:02:11 / cg"

! !

!AbstractSyntaxHighlighter class methodsFor:'highlighting'!

colorize:text forErrorAtPosition:pos withOriginal:originalString

    |eColor endPos|

    endPos := pos + 1.

    "/ mhmh - which is better ...

    "/ alternative1: colorize the rest after the error in red

    eColor := UserPreferences current errorColor.

    eColor notNil ifTrue:[

        ^ text

            emphasizeFrom:endPos 

            to:text size 

            with:(#color->eColor).

    ].

    "/ alternative2: take the original emphasis for the rest

    endPos >= text size ifTrue:[

        ^ text

    ] ifFalse:[

        ^ (text copyTo:endPos) , (originalString copyFrom:(endPos+1))

    ].

    "/ alternative3: no emphasis for rest.

    ^ text

! !

!AbstractSyntaxHighlighter class methodsFor:'misc'!

collectionEnumerationSelectors

    "these are considered wellknown, builtin selectors of very common

     collection enumeration methods.

     These are optionally shown with another color (dark green)"

    ^ #(

	collect:

	select:

	inject:into:

	count:

	collect:thenSelect:

	select:thenCollect:

    )

    "Created: / 14-02-2012 / 15:56:59 / cg"

!

controlFlowSelectors

    "these are considered wellknown, builtin selectors of very common

     control flow constructs. Correspond to syntax or special forms in other

     languages. These are optionally shown with another color (blue)"

    ^ #(

        ifTrue: ifFalse:

        ifTrue:ifFalse: ifFalse:ifTrue:

        ifNil: ifNotNil:

        ifNil:ifNotNil: ifNotNil:ifNil:

        and: or:

        whileTrue:

        whileFalse:

        to:do:

        downTo:do:

        to:by:do:

        loop

        repeat

        whileTrue

        whileFalse

        doWhile:

        doUntil:

        do:

        doWithIndex:

        pairWiseDo:

        keysAndValuesDo:

        withPriority:do:

        handle:do:

        on:do:

        catch:

        ignoreIn:

        "/ newProcess

        fork:

        ensure:

        ifCurtailed:

        valueOnUnwindDo:

        valueNowOrOnUnwindDo:

        caseOf:

        caseOf:otherwise:

    )

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

!

debugSelectors

    "these are considered harmful if left in a deployed application:

     selectors for debugging which open a debugger (unless haltSignal is

     caught or disabled, which end-user apps should do).

     These are optionally shown with another color (redish)"

    ^ #(

	halt halt:

    )

    "Modified (comment): / 27-07-2013 / 11:45:07 / cg"

!

errorRaisingSelectors

    "these are error raisers.

     These are optionally shown with another color (red)"

    ^ #(

        error error: error:mayProceed: proceedableError:

        raise raiseRequest:

        raiseErrorString: raiseRequestErrorString:

        raiseWith: raiseRequestWith:

        raiseWith:errorString: raiseRequestWith:errorString:

        subclassResponsibility

        obsoleteMethodWarning obsoleteMethodWarning:

        shouldNeverBeReached shouldNeverBeSent 

        shouldNotImplement shouldImplement

        subscriptBoundsError typeCheckError

        elementBoundsError errorInvalidFormat

        elementNotCharacter elementNotInteger

        errorKeyNotFound: errorNotFound errorNotFound:

        indexNotInteger indexNotInteger:

        indexNotIntegerOrOutOfBounds:

        mustBeRectangle mustBeString notIndexed

        notYetImplemented primitiveFailed

    )

    "Modified: / 28-05-2018 / 15:02:43 / Claus Gittinger"

!

isControlFlowSelector:aSelector

    "these are considered wellknown, builtin selectors of very common

     control flow constructs. Correspond to syntax or special forms in other

     languages. These are optionally shown with another color (blue)"

    (self controlFlowSelectors includesIdentical:aSelector) ifTrue:[^ true].

    true "((aSelector startsWith:'with') or:[ aSelector startsWith:'all'])" ifTrue:[

	((aSelector endsWith:'do:') or:[ aSelector endsWith:'Do:']) ifTrue:[

	    ^ true

	]

    ].

    ^ false.

! !

!AbstractSyntaxHighlighter class methodsFor:'queries'!

isAbstract

    ^ self == AbstractSyntaxHighlighter

! !

!AbstractSyntaxHighlighter class methodsFor:'utilities'!

mark:sourceText from:pos1 to:pos2 withAddedEmphasis:addedEmphasis

    sourceText emphasisFrom:pos1 to:pos2 add:addedEmphasis

    "Created: / 01-06-2012 / 21:43:36 / cg"

!

mark:sourceText from:pos1 to:pos2 withEmphasis:fontEmp color:clrIn

    self mark:sourceText from:pos1 to:pos2 withEmphasis:fontEmp color:clrIn font:nil

!

mark:sourceText from:pos1 to:pos2 withEmphasis:fontEmp color:clrIn font:fontIn

    "all positions are 1-based"

    |e p2 clr|

    (clrIn isNil or:[clrIn = Color black]) ifTrue:[

        e := fontEmp

    ] ifFalse:[

        clr := clrIn onDevice:Screen current.

        fontEmp isNil ifTrue:[

            e := (#color->clr)

        ] ifFalse:[

            e := Text addEmphasis:fontEmp to:(#color->clr).

        ]

    ].

    fontIn notNil ifTrue:[

        e := Text addEmphasis:e to:(#font->fontIn)

    ].

    (p2 := pos2) isNil ifTrue:[

        p2 := sourceText size

    ] ifFalse:[

        p2 := p2 min:sourceText size

    ].

    sourceText emphasizeFrom:pos1 to:p2 with:e

    "Created: / 01-06-2012 / 21:42:41 / cg"

    "Modified (comment): / 21-10-2017 / 14:24:20 / cg"

!

mark:sourceText from:pos1 to:pos2 withEmphasis:fontEmp color:fgClr1 ifNil:fgClr2 backgroundColor:bgClr

    |e p2 clr fgClr|

    fgClr := fgClr1 ? fgClr2.

    (fgClr isNil or:[fgClr = Color black]) ifTrue:[

	e := fontEmp

    ] ifFalse:[

	clr := fgClr onDevice:Screen current.

	fontEmp isNil ifTrue:[

	    e := (#color->clr)

	] ifFalse:[

	    e := Text addEmphasis:fontEmp to:(#color->clr).

	]

    ].

    bgClr notNil ifTrue:[

	e := Text addEmphasis:(#backgroundColor->bgClr) to:e.

    ].

    (p2 := pos2) isNil ifTrue:[

	p2 := sourceText size

    ] ifFalse:[

	p2 := p2 min:sourceText size

    ].

    sourceText emphasizeFrom:pos1 to:p2 with:e

    "Created: / 01-06-2012 / 21:44:17 / cg"

!

mark:sourceText from:pos1 to:pos2 withEmphasis:fontEmp ifNil:fontEmp2 color:fgClr1 ifNil:fgClr2 backgroundColor:bgClr

    |e p2 clr fgClr|

    fgClr := fgClr1 ? fgClr2.

    (fgClr isNil or:[fgClr = Color black]) ifTrue:[

        e := fontEmp ? fontEmp2

    ] ifFalse:[

        clr := fgClr onDevice:Screen current.

        (fontEmp ? fontEmp2) isNil ifTrue:[

            e := (#color->clr)

        ] ifFalse:[

            e := Text addEmphasis:(fontEmp ? fontEmp2) to:(#color->clr).

        ]

    ].

    bgClr notNil ifTrue:[

        e := Text addEmphasis:(#backgroundColor->bgClr) to:e.

    ].

    (p2 := pos2) isNil ifTrue:[

        p2 := sourceText size

    ] ifFalse:[

        p2 := p2 min:sourceText size

    ].

    sourceText emphasizeFrom:pos1 to:p2 with:e

    "Created: / 01-06-2012 / 21:44:17 / cg"

! !

!AbstractSyntaxHighlighter methodsFor:'accessing'!

fetchHeavilyUsedPreferenceValues

    preferences isNil ifTrue:[

        commentColor :=  commentEmphasis := commentFont := nil.

        constantColor := constantEmphasis := nil.

        ^ self.

    ].

    commentColor := preferences commentColor.

    commentEmphasis := preferences commentEmphasis.

    commentFont := preferences commentFont.

    constantColor := preferences constantColor.

    constantEmphasis := preferences constantEmphasis.

    "Created: / 21-10-2017 / 14:13:33 / cg"

!

method:aMethod

    "the original method, if known (for subclasses which can make use of it)"

    method := aMethod.

    "Created: / 28-04-2010 / 13:15:33 / cg"

!

preferences:aUserPreferencesInstance

    preferences := aUserPreferencesInstance.

    fullSelectorCheck := preferences fullSelectorCheck.

    self fetchHeavilyUsedPreferenceValues.

    "Modified: / 21-10-2017 / 14:20:06 / cg"