Syntax highlighting for ObjectScript

ROUTINE ColorJSON

#include %occStatus

    // demonstration of using %SyntaxColor to output coloring information in JSON format
    
    // example code to be syntax checked
    // - lines for the syntax checker must begin with space or tab if there is no label
    Set n=0
    Set code($I(n))=" Set sum=0"
    Set code($I(n))=" For i=1:1 {"
    Set code($I(n))="  Read ""Number (return to finish): "",in,!"
    Set code($I(n))="  If in="""" {Quit}"
    Set code($I(n))="  Set sum=sum+in"
    Set code($I(n))=" }"
    Set code($I(n))=" Write ""Sum is: "",sum,!"
    Set code($I(n))=" Quit"
    
    // list code to current device
    Write !,"Code:",!
    For lineno=1:1:n {
        Write lineno,": ",code(lineno),!
    }
    Write !,"--",!!
    
    // write code to a stream and rewind it for reading
    Set input=##class(%GlobalCharacterStream).%New() If '$IsObject(input) {$$$ThrowStatus(%objlasterror)}
    For lineno=1:1:n {
        $$$THROWONERROR(sc,input.WriteLine(code(lineno)))
    }
    $$$THROWONERROR(sc,input.Rewind())
        
    // stream for coloring-output
    Set output=##class(%GlobalCharacterStream).%New() If '$IsObject(output) {$$$ThrowStatus(%objlasterror)}
    
    // create syntax checker
    Set syn=##class(%SyntaxColor).%New() If '$IsObject(syn) {$$$ThrowStatus(%objlasterror)}
    
    // top-level language (moniker) of source code
    Set language="COS"
    
    // flags for JSON output ("K" can't be used with "C" or "H")
    Set flags="K"
    
    // invoke syntax checker
    // - the Color method returns 1 for OK, 0 for ERROR (same applies to the Languages and Attributes methods) 
    If 'syn.Color(input,output,language,flags,,,,.coloringerrors) {
        Throw ##class(%Exception.General).%New("- error calling %SyntaxColor:Color: "_syn.DLLResultCode) // error details are in the DLLResultCode property
    }

    If coloringerrors {
        Write "(coloring errors)",!!
    }
    
    Do ShowJSON(syn,output)
    
    Quit

    
ShowJSON(syn,stream)
{
    Write "Raw JSON:",!
    $$$THROWONERROR(sc,stream.Rewind())
    While 'stream.AtEnd {
        Write stream.ReadLine(,.sc),! If $$$ISERR(sc) {$$$ThrowStatus(sc)}
    }
    Write !,"--",!!

    Write "Decoded JSON:",!
    Write " - format is: OFFSET(COUNT) LANGUAGE:ATTRIBUTE",!
    $$$THROWONERROR(sc,stream.Rewind())
    Set json={}.%FromJSON(stream.Read(,.sc)) If $$$ISERR(sc) {$$$ThrowStatus(sc)}
    
    // for each line ..
    // (the %GetNext loops could alternatively be done using a For loop starting at 0) 
    Set linesiter=json.%GetIterator()
    While linesiter.%GetNext(.lineno,.linejson) {
    
        Write !,"Line ",lineno+1,! // this array is numbered from 0 so we need to add 1 to get a line number corresponding to the code listing
        
        // for each colored item in the line
        Set onelineiter=linejson.%GetIterator()
        While onelineiter.%GetNext(,.item) {
            Write " ",$$ShowItem(syn,item),!
        }        
    }
    Write !,"--",!!
}


ShowItem(syn,item)
{
    Quit item.p_"("_item.c_") "_$$Language(syn,item.l)_":"_$$Attribute(syn,item.l,item.s)
}


Language(syn,langindex)
{
    // in a real program this should be cached
    If 'syn.Languages(.languages) {Throw ##class(%Exception.General).%New("- error calling %SyntaxColor:Languages: "_syn.DLLResultCode)}
    Quit $List(languages,langindex+1) // first language index is 0 so we need to add 1 to langindex
}


Attribute(syn,langindex,attrindex)
{
    // in a real program this should be cached
    If 'syn.Attributes(langindex,.attributes) {Throw ##class(%Exception.General).%New("- error calling %SyntaxColor:Attributes: "_syn.DLLResultCode)}
    Quit $List(attributes,attrindex+1) // first attribute index is 0 so we need to add 1 to attrindex
}