//TH-Header
//*****************************************************************************************
// Copyright (c)  2014  KURANT Project
// All rights reserved.
//
// $FileName    : Codepub.pkg
// $ProjectName : The Hammer 2.0
// $Authors     : Wil van Antwerpen, Michael Kurz, Sergey V. Natarov, Bernhard Ponemayr
// $Created     : 01.25.2014  01:08
// $Type        : LGPL
//
// Contents:
// This package outputs your current source file with html markup.
// It outputs the code with syntax coloring. 
//
//*****************************************************************************************
//TH-RevisionStart
//TH-RevisionEnd

// CodePub.pkg
Use OldStatusPanel.pkg
Use cLineParserWhiteSpace.pkg

Register_Procedure SetTitle
Register_Procedure ShowInfo
Register_Procedure HideInfo

//Define CODEPub_TAG_STPub    For ("/"+"/")
//Define CODEPub_TAG_END      For ("")
//Define CODEPub_WARNING      For ("/"+"/CA-Warning/")

Define TH_CP_EXP_SCOPE      For 0
Define TH_CP_EXP_STRING     For 1
Define TH_CP_EXP_TOKEN      For 2
Define TH_CP_EXP_OPERATOR   For 3
Define TH_CP_EXP_KEYWORD    For 4
Define TH_CP_EXP_COMMAND    For 5
Define TH_CP_EXP_DIGIT      For 6

Class cCodePub Is an Array
        //Insert your Properties here.
    Procedure Construct_Object
        Forward Send Construct_Object
            // Failed to load info, so disabled
        Property Integer CodePub_Disabled_State    False
            // Current Language Scope:
        Property String  CodePub_Scope_Start       ""
        Property String  CodePub_Scope_End         ""
        Property String  CodePub_Keywords          ""
        Property String  CodePub_Operators         ""
        Property String  CodePub_Comment           ""
            //                                    
        Property String  psOutFile                 "codepub.htm"
        Property String  psGenerator               "The Hammer CodePub Utility 1.1"
            //                                    
        Property Integer piErrorCount              0
        Property Integer piCurrentScope            0
        Property Integer piTabSize                 4
        Property Integer piLineCount               0
        Property Integer piHeaderState             False
            //                                    
        Property Integer pbHeaderFile              False
        Property Integer pbFooterFile              False
            //
        Object oLP1 Is a cPreserveSpaceLineParser
            Set piLanguageTokens To True
        End_Object
            //
        Object oScope Is a Array
        End_Object
            //
        Object oErrors Is a Array
        End_Object
            //
    End_Procedure
    //
    Procedure LoadKeywords String sSt String sEn String sKw String sOp
        Set CodePub_Scope_Start To (Uppercase("|"+(Trim(Replaces("\n",sSt,"|")))+"|"))
        Set CodePub_Scope_End   To (Uppercase("|"+(Trim(Replaces("\n",sEn,"|")))+"|"))
        Set CodePub_Keywords    To (Uppercase("|"+(Trim(Replaces("\n",sKw,"|")))+"|"))
        Set CodePub_Operators   To (Uppercase("|"+(Trim(Replaces("\n",sOp,"|")))+"|"))
    End_Procedure
    //
    Procedure LoadEntries
        String sName sScopeStart sScopeEnd sKeyWords sOperators
        Integer iC iRet
        Get psLanguage Of ghoEditorProperties To sName
        If (sName<>"") Begin
            Get FindLanguage Of ghoEditorProperties sName To iC
            If (iC>=0)  Begin
                Set CodePub_Comment To (psLanguages.szSingleLineComments(ghoEditorProperties,iC))
                Move (psLanguages.szScopeKeywords1(ghoEditorProperties,iC)) To sScopeStart
                Move (psLanguages.szScopeKeywords2(ghoEditorProperties,iC)) To sScopeEnd
                Move (psLanguages.szKeywords(ghoEditorProperties,iC))       To sKeyWords
                Move (psLanguages.szOperators(ghoEditorProperties,iC))      To sOperators
                Send LoadKeywords (Trim(sScopeStart)) (Trim(sScopeEnd)) (Trim(sKeyWords)) (Trim(sOperators))
            End
            Else Set CodePub_Disabled_State To True
        End
    End_Procedure
    //
    Function Tab_String Integer iScope Returns String
        String sRet sSpace
        Integer iTab
        If (iScope=0) Function_Return ""
        Get piTabSize       To iTab
        If (iTab=0) Move 4  To iTab
        Move (Repeat("&nbsp;", (iTab))) To sSpace
        If (iScope=1) Function_Return sSpace
        Move (Repeat(sSpace, iScope)) To sRet
        Function_Return sRet
    End_Function
    //
    Function IsDigit String sWd Returns Integer
        Integer iC
        String sCh
        
        Move (trim(sWd)) To sWd
        If (left(Uppercase(sWd),4)="|CI$") Move (Replace(left(sWd,4),sWd,"")) To sWd
        If (left(Uppercase(sWd),3)="|CI")  Move (Replace(left(sWd,3),sWd,"")) To sWd
        
        For iC From 1 To (Length(sWd))
            Move (Mid(sWd, 1, iC)) To sCh
            Ifnot sCh In "0123456789.-" Function_Return 0
        Loop
        Function_Return 1
    End_Function
    //
    Procedure Output_Line String sTab String sLine
        String sOutLine sE sEF
        Integer iC iT
        Integer iDig
        
        If (RTrim(sLine)="") Begin
            Writeln "<br />"
            Procedure_Return
        End

        Send ParseLine To (oLP1(Self)) sLine
        ////////////////////////////
        For iC From 0 To (Item_Count(oLP1(Self))-1)
            Get Value Of (oType(oLP1(Self))) Item iC To iT
            If (iT=CLINEPARSER_EXPRESSION) Begin
                Get Value Of oLP1 Item iC To sE
                Get FormatExpression sE To sEF
                Move (sOutLine+'<font class="Operator">'+sEF+"</font> ") To sOutLine
            End
            Else If (iT=CLINEPARSER_COMMAND) Begin
                Get Value Of oLP1 Item iC To sE
                Move (sOutLine+'<font class="Keyword">'+sE+"</font> ") To sOutLine
            End
            Else If (iT=CLINEPARSER_KEYWORD) Begin
                Get Value Of oLP1 Item iC To sE
                Get IsDigit sE To iDig
                If (iDig) Move (sOutLine+'<font class="Digit">'+sE+"</font> ") To sOutLine
                Else Begin
                    If ("|"+Uppercase(sE)+"|") In (CodePub_Keywords(Self))         Move (sOutLine+'<font class="Keyword">'+sE+"</font> ") To sOutLine
                    Else If ("|"+Uppercase(sE)+"|") In (CodePub_Scope_Start(Self)) Move (sOutLine+'<font class="Keyword">'+sE+"</font> ") To sOutLine
                    Else If ("|"+Uppercase(sE)+"|") In (CodePub_Scope_End(Self))   Move (sOutLine+'<font class="Keyword">'+sE+"</font> ") To sOutLine
                    Else If ("|"+Uppercase(sE)+"|") In (CodePub_Operators(Self))   Move (sOutLine+'<font class="Operator">'+sE+"</font> ") To sOutLine
                    Else Move (sOutLine+'<font class="Token">'+sE+"</font> ") To sOutLine
                End
            End
            Else If (iT=CLINEPARSER_COMMENT) Begin
                Get Value Of oLP1 Item iC To sE  
                If "<" In sE Move (Replaces("<",sE,"&lt;")) To sE
                If ">" In sE Move (Replaces(">",sE,"&gt;")) To sE
                Move (Replaces(" ",sE,"&nbsp;")) To sE
                Move (sOutLine+'<font class="Comment">'+sE+"</font> ") To sOutLine
            End
            Else If (iT=CLINEPARSER_STRING) Begin
                Get Value Of oLP1 Item iC To sE
                If "<" In sE Move (Replaces("<", sE, "&lt;")) To sE
                If ">" In sE Move (Replaces(">", sE, "&gt;")) To sE
                Move (Replaces(" ",sE,"&nbsp;")) To sE
                Move (sOutLine+'<font class="String">'+sE+"</font> ") To sOutLine
            End
            Else If (iT=CLINEPARSER_INDICATOR) Begin
                Get Value Of oLP1 Item iC To sE
                Move (sOutLine+'<font class="Indicator">'+sE+"</font> ") To sOutLine
            End
            Else If (iT=CLINEPARSER_WHITESPACE) Begin
                Get Value Of oLP1 Item iC To sE
                Move (Replaces(" ",sE,"&nbsp;")) To sE
                Move (sOutLine+'<font class="WhiteSpace">'+sE+"</font> ") To sOutLine
            End
            
        Loop
        Writeln sTab sOutLine "<br />"
    End_Procedure
    //
    Function Add_Keyword Integer hoID Integer hoType String sKW Returns String
        Integer iType iDigit
        Move -1 To iType

        Get IsDigit sKW To iDigit
        If (iDigit) Begin
            Set Value Of hoID   Item (Item_Count(hoID)) To sKw
            Set Value Of hoType Item (Item_Count(hoType)) To TH_CP_EXP_DIGIT
            Function_Return ""
        End

             If ("|"+Uppercase(sKW)+"|") In (CodePub_Scope_Start(Self)) Move TH_CP_EXP_COMMAND  To iType
        Else If ("|"+Uppercase(sKW)+"|") In (CodePub_Scope_End(Self))   Move TH_CP_EXP_COMMAND  To iType
        Else If ("|"+Uppercase(sKW)+"|") In (CodePub_Keywords(Self))    Move TH_CP_EXP_COMMAND  To iType
        Else If ("|"+Uppercase(sKW)+"|") In (CodePub_Operators(Self))   Move TH_CP_EXP_OPERATOR To iType
        Else Move TH_CP_EXP_KEYWORD To iType

        Set Value Of hoID Item (Item_Count(hoID)) To sKw
        Set Value Of hoType Item (Item_Count(hoType)) To iType
        Function_Return ""
    End_Function
    //
    Function FormatExpression String sExp Returns String
        Integer iChr hoID iQt hoType
        String  sChr sStr sOri sKw
        Integer iType

        Move (Replaces(",", sExp, ", ")) To sExp
        While "  " In sExp
            Move (Replaces("  ", sExp, " ")) To sExp
        Loop
        While "( " In sExp
            Move (Replaces("( ", sExp, "(")) To sExp
        Loop
        While " )" In sExp
            Move (Replaces(" )", sExp, ")")) To sExp
        Loop
        //
        Get Create U_Array To hoID
        Get Create U_Array To hoType
        Move sExp To sOri
        For iChr From 1 To (Length(sOri))

            Move (Mid(sOri, 1, iChr)) To sChr
            If ((sChr="(")Or(sChr=")")) Begin
                If (sKw<>"") Get Add_Keyword hoID hoType sKW    To sKW
                Set Value Of hoID   Item (Item_Count(hoID))     To sChr
                Set Value Of hoType Item (Item_Count(hoType))   To TH_CP_EXP_SCOPE
            End
            Else If ((sChr=",")Or(sChr=" ")) Begin
                If (sKw<>"") Get Add_Keyword hoID hoType sKW    To sKW
                Set Value Of hoID   Item (Item_Count(hoID))     To sChr
                Set Value Of hoType Item (Item_Count(hoType))   To TH_CP_EXP_TOKEN
            End
            Else If (sChr="'") Begin
                Move (sStr+sChr) To sStr
                Move "" To sChr
                While ((sChr<>"'")And(iChr<=Length(sOri)))
                    Move (iChr+1) To iChr
                    Move (Mid(sOri, 1, iChr)) To sChr
                    Move (sStr+sChr) To sStr
                Loop
                Set Value Of hoID   Item (Item_Count(hoID))     To sStr
                Set Value Of hoType Item (Item_Count(hoType))   To TH_CP_EXP_STRING
                Move "" To sStr
            End
            Else If (sChr='"') Begin
                Move (sStr+sChr) To sStr
                Move "" To sChr
                While ((sChr<>'"')And(iChr<=Length(sOri)))
                    Move (iChr+1) To iChr
                    Move (Mid(sOri, 1, iChr)) To sChr
                    Move (sStr+sChr) To sStr
                Loop
                Set Value Of hoID   Item (Item_Count(hoID))     To sStr
                Set Value Of hoType Item (Item_Count(hoType))   To TH_CP_EXP_STRING
                Move "" To sStr
            End
            Else Begin
                If ("|"+Uppercase(sChr)+"|") In (CodePub_Operators(Self)) Begin
                    If (sKw<>"") Get Add_Keyword hoID hoType sKW    To sKW
                    Set Value Of hoID   Item (Item_Count(hoID))     To sChr
                    Set Value Of hoType Item (Item_Count(hoType))   To TH_CP_EXP_OPERATOR
                End
                Else Move (sKW+sChr) To sKW
            End
        Loop

        Move "" To sExp
        For iChr From 0 To (Item_Count(hoID)-1)
            Get Value Of hoID   Item iChr To sChr
            Get Value Of hoType Item iChr To iType
            If "<" In sChr Move (Replaces("<",sChr,"&lt;")) To sChr
            If ">" In sChr Move (Replaces(">",sChr,"&gt;")) To sChr
            If " " Eq sChr Move (Replace (" ",sChr,"&nbsp;")) To sChr
            If      (iType=TH_CP_EXP_SCOPE)      Move (sExp+'<font class="Token">'  +sChr+"</font>") To sExp
            Else If (iType=TH_CP_EXP_STRING)     Move (sExp+'<font class="String">' +sChr+"</font>") To sExp
            Else If (iType=TH_CP_EXP_TOKEN)      Move (sExp+'<font class="Token">'  +sChr+"</font>") To sExp
            Else If (iType=TH_CP_EXP_OPERATOR)   Move (sExp+'<font class="Operator">'+sChr+"</font>") To sExp
            Else If (iType=TH_CP_EXP_KEYWORD)    Move (sExp+'<font class="Token">'  +sChr+"</font>") To sExp
            Else If (iType=TH_CP_EXP_COMMAND)    Move (sExp+'<font class="Keyword">'+sChr+"</font>") To sExp
            Else If (iType=TH_CP_EXP_DIGIT)      Move (sExp+'<font class="Digit">'  +sChr+"</font>") To sExp
        Loop

        //
        Send Destroy To hoID
        Send Destroy To hoType
        Function_Return sExp
    End_Function
    //
    Procedure Process_Line String sLine
        String sLineNo sScope sTab sWd sCom sComLn sCmd sLnCmnt sErr sOutLine
        Integer iScope iLineNo iStart iEnd iBegin iOk iType iComment
        Integer iC iT
        String  sE sEF
        
        Get piCurrentScope  To iScope
        Move (Trim(sLine)) To sLine
        If (sLine = "") Send Output_Line "" sLine
        //
        Send ParseLine To (oLP1(Self)) sLine
        Get Value Of (oLP1(Self))           Item 0 To sScope
        Get Value Of (oType(oLP1(Self)))    Item 0 To iType
        Get Value Of (oLP1(Self)) Item (Item_Count(oLP1(Self))-1) To sCmd
        ////////////////////////////

        ////////////////////////////
        If (Uppercase(sCmd)="BEGIN") Move 1 To iBegin

        Move (Uppercase("|"+sScope+"|")) To sWd
        Move 0 To iStart
        Move 0 To iEnd
        If (iBegin) Move 1 To iStart
        Move 0 To iOk
        If sWd In (CodePub_Scope_Start(Self)) Begin
            Move 1 To iStart
            Move 1 To iOk
        End
        If sWd In (CodePub_Scope_End(Self))   Begin
            Move 1 To iEnd
            Move 1 To iOk
        End
        If sWd In (CodePub_Keywords(Self))    Begin
            Move 1 To iOk
        End
        If ((iStart)And(iEnd)) Begin
            Decrement iScope
            Get Tab_String iScope To sTab
            Send Output_Line sTab sLine
            Increment iScope
            Move "" To sLine
        End
        Else If iStart Begin
            Get Tab_String iScope To sTab
            Send Output_Line sTab sLine
            Increment iScope
            Set Value Of (oScope(Self)) Item iScope To ( (Value(oLP1(Self),0)) + " " + (Value(oLP1(Self),1)) )
            Move "" To sLine
        End
        Else If iEnd Begin
            Decrement iScope
            Get Tab_String iScope To sTab
            Send Output_Line sTab sLine
            Move "" To sLine
        End

        If (sLine<>"") Begin
            Get Tab_String iScope To sTab
            Send Output_Line sTab sLine
        End

        Set piCurrentScope  To iScope
        Set piLineCount     To (piLineCount(Self)+1)
    End_Procedure
    //
    Procedure Init_CodePub
        Set piErrorCount    To 0
        Set piCurrentScope  To 0
        Set piLineCount     To 0
        Set piHeaderState   To False
        Set pbHeaderFile    To False
        Set pbFooterFile    To False
        Send Delete_Data    To (oScope(Self))
        Send Delete_Data    To (oErrors(Self))
    End_Procedure
    //
    Procedure Write_Header String sInFile
        String sGenerator
        
        Get psGenerator To sGenerator
        Writeln '<' (character(33)) 'DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">'
        Writeln "<html>"
        Writeln "<head>"
        Writeln '<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">'
        Writeln "<title>Code Publishing Utility - " sInFile "</title>"
        Writeln '<meta name="GENERATOR" content="' sGenerator '">'
        Writeln '<style type="text/css">' 
        Writeln '  body { font-size: 75%; font-family: "Vera Sans Mono", "DejaVu Sans Mono", "Courier New", "Courier", "monospace"; }'
//        Writeln "  font.Comment   {color: " "Green  "  "; font-family : Verdana, Arial, Helvetica, sans-serif; font-size: 8pt;}"
        Writeln "  font.Comment    { font-size: small; color: " "Green  "  "; }"
        Writeln "  font.Keyword    { font-size: small; color: " "Blue   "  "; }"
        Writeln "  font.Digit      { font-size: small; color: " "#FF00FF"  "; }"
        Writeln "  font.Operator   { font-size: small; color: " "#808000"  "; }"
        Writeln "  font.Token      { font-size: small; color: " "Black  "  "; }"
        Writeln "  font.String     { font-size: small; color: " "Red    "  "; }"
        Writeln "  font.Indicator  { font-size: small; color: " "#FFFF00"  "; }"
        Writeln "  font.WhiteSpace { font-size: small; color: " "Black  "  "; }"
        Writeln "</style>"
        Writeln "</head>"
        Writeln
        Writeln '<body>'
        Writeln '<table border="1" cellpadding="10" cellspacing="0" style="border:1px dashed Gray;"><tr>'
        Writeln '<td bgcolor="#000080" align="center"><strong><font color="#FFFFFF" size="2" face="Verdana">' sInFile '</font></strong></td></tr>'
        Writeln '<tr><td bgcolor="#FEFEFE">'
        Writeln
    End_Procedure
    //
    Procedure Write_Footer
        String sGenerator
        
        Get psGenerator To sGenerator
        Writeln
        Writeln "</td></tr></table>"
        Writeln '<table border="0" cellpadding="0" cellspacing="0"><tr>'
        Writeln '<td><strong><font size="-2" face="Verdana">Published using ' sGenerator '</font></strong></td></tr>'
        Writeln "</table>"
        Writeln "</body>"
        Writeln "</html>"
        Writeln
    End_Procedure
    //
    // Returns name of out file or nothing
    Function CodePub String sFile Returns String
        String sInFile sOutFile sLine sLineNo sScope sTab sWd sErr sErrDesc sHdr sFtr
        Integer iScope iLineNo iErr iCnt
        If (Trim(sFile)="")                 Function_Return "ERROR: No Source File Specified"
        If (CodePub_Disabled_State(Self))   Function_Return "ERROR: CodePub Can't Load Current Language Keywords!"
        Send Init_CodePub
        //
        Move sFile To sInFile
        Send SetTitle To ghoStatusPanel sInFile
        Move (sFile+".htm")  To sOutFile
        Set psOutFile To sOutFile

        If (psCodePubFooterFile(ghoEditorProperties)<>"") Set pbFooterFile To True
        If (psCodePubHeaderFile(ghoEditorProperties)<>"") Begin
            Set pbHeaderFile To True
            Move (psCodePubHeaderFile(ghoEditorProperties)) To sHdr
            Direct_Input  sHdr
            Direct_Output sOutFile
            While (Not(seqeof))
                Readln  sLine
                Writeln sLine
            Loop
            Close_Input
            Writeln
        End
        Else Direct_Output sOutFile

        Direct_Input  sInFile
        If (Not(pbHeaderFile(Self))) Send Write_Header sInFile

        Repeat
            Readln sLine
            [Not seqeof] Send Process_Line sLine
            Send ShowInfo To ghoStatusPanel ("Processing line "+String(piLineCount(Self))+" ...")
        Until [seqeof]
        Close_Input

        If (Not(pbFooterFile(Self))) Begin
            Send Write_Footer
        End
        Else Begin
            Move (psCodePubFooterFile(ghoEditorProperties)) To sFtr
            Direct_Input sFtr
            While (Not(seqeof))
                Readln  sLine
                Writeln sLine
            Loop
            Close_Input
        End
        Close_Output

        Send HideInfo To ghoStatusPanel
        If (piErrorCount(Self)>0) Begin
            Get piErrorCount To sErr
            Move ("\n\n"+sErr+" warnings found during file processing.\nFile may be converted improperly: \n\n") To sErr
            Move (Item_Count(oErrors(Self))-1) To iCnt
            If (iCnt>4) Move 4 To iCnt // Output first 5 errors...
            For iErr From 0 To iCnt
                Get Value Of (oErrors(Self)) Item iErr To sErrDesc
                Move (sErr+sErrDesc+"\n") To sErr
            Loop
//            If (pbCodePubInsertErrors(ghoEditorProperties)) ;
//            Move (sErr+"...\n\nSee Converted file for details. All errors marked as '"+CODEPub_WARNING+"'") To sErr
        End
        If (piCurrentScope(Self)) Function_Return ("ERROR: Scope count mismatch.\n\n"+sErr)
        Function_Return ("Published file is "+sOutFile+sErr)
    End_Function
    //
    Procedure End_Construct_Object
        Forward Send End_Construct_Object
        Send LoadEntries
    End_Procedure
End_Class

Integer ghoCodePub
Object oCodePub Is a cCodePub
    Move Self To ghoCodePub
End_Object