/* proparseToXML.p - render the proparse nodeTree as an XML document          */
/******************************************************************************/
/*                                                                            */
/******************************************************************************/
&scoped-define writeLineBreak       yes
&scoped-define dontWriteLineBreak   no

define variable parser           as handle      no-undo.
{proparse/api/proparse.i parser}

define variable filename         as character   no-undo.
define variable outfile          as character   no-undo.

/* ********************** Function Definitions ************************** */
function startElementTag returns character
   (input pcTag as character):
/*------------------------------------------------------------------------------
       Purpose:     Returns a StartElement tag, given a string.
       Parameters:  pcTag - String to be tagged.
       Notes:
------------------------------------------------------------------------------*/
   
   return substitute("<&1>&2", pcTag,
                               "&1").
end function.

function endElementTag returns character
   (input pcTag as character):
/*------------------------------------------------------------------------------
       Purpose:     Returns an endElement tag, given a string.
       Parameters:  pcTag - String to be tagged.
       Notes:
------------------------------------------------------------------------------*/
   
   return substitute("</&1>", pcTag).
end function.


function createWholeElementTemplate returns character
   (input pcTag as character):
/*------------------------------------------------------------------------------
       Purpose:     Returns an entire Element template for a given tag.
       Parameters:  pcTag - String to be tagged.
       Notes:
------------------------------------------------------------------------------*/
   
   return substitute("&1&2&3", startElementTag(input pcTag),
                               "&1",
                               endElementTag(input pcTag)).

end function.


function addAttribute returns character
   (input pcNode      as character,
    input pcAttrName  as character,
    input pcAttrValue as character):
/*------------------------------------------------------------------------------
       Purpose:     Adds an attribute to a tag
       Parameters:  pcTag - The tag to add attribute to.   
                    pcAttrName - the attribute name.       
                    pcAttrValue - the attribute value.     
       
       Notes:
------------------------------------------------------------------------------*/
   
   return replace(pcNode, ">", substitute(" &1=&2>", pcAttrName, quoter(pcAttrValue))).
end function.

function scrub returns character
   (input pcValue     as character):
/*------------------------------------------------------------------------------
       Purpose:     Scrubs an element value of unsavory characters
       Parameters:  pcValue - the value to be cleaned up 
       Notes:
------------------------------------------------------------------------------*/
   define variable cRetValue as character no-undo.
   
   cRetValue = pcValue.
   
   cRetValue = replace(cRetValue, "&",  "&amp;").
   cRetValue = replace(cRetValue, "<",  "&lt;").
   cRetValue = replace(cRetValue, ">",  "&gt;").
   cRetValue = replace(cRetValue, "'",  "&apos;").
   cRetValue = replace(cRetValue, "~"", "&quot;").
   return cRetValue.
end function.

/******************************* main block *********************************/
on "close" of this-procedure do:
   delete procedure this-procedure.
end.

run proparse/api/proparse.p persistent set parser.

/* ************************ Internal Procedures ************************* */

procedure analyzeThis:
/*------------------------------------------------------------------------------
       Purpose:     invoke proparse for the given file
       Parameters:  character - pcSourcefile name of file to parse
       Notes:
------------------------------------------------------------------------------*/
   
   define variable cErrorMessage as character no-undo initial "":U.
   define variable topNode as integer no-undo.
   
   output to value(outfile).

   run writeXMLHeader.
   
   /* parse sourcefile in proparse.dll */          
   if not parserParse(filename) then
      cErrorMessage = parserErrorGetText().

   if cErrorMessage <> "":U then do:
      message substitute("Parsing Error in &1 : &2", 
                                     filename, 
                                     cErrorMessage)
      view-as alert-box info buttons ok.
   end.      
   else do:

      topNode = parserGetHandle().  /* note: must be assigned after parserParse() */
      parserNodeTop(topNode).       /* this gets us the "Program_root" node */

      /* this is where we do the real work. */
      run processTree (input topNode).

      parserReleaseHandle(topNode).
   end.
   
   output close.

end procedure.

procedure processTree:
/*------------------------------------------------------------------------------
       Purpose:     to recursively descend through the tree, starting at the
                    given node
       Parameters:  theNode       = the root node to process

       Notes:       
------------------------------------------------------------------------------*/
   define input parameter theNode      as integer no-undo.

   define variable cNodeType  as character   no-undo.
   define variable child      as integer     no-undo.
   define variable grandchild as integer     no-undo.

   assign 
      child       = parserGetHandle()
      grandchild  = parserGetHandle().
      
   /* output startElement */
   run writeNodeStartElement(input theNode, input {&writeLineBreak}).

   assign cNodeType = parserNodeFirstChild(theNode, child).

   do while cNodeType <> "":
      /* If this node has children, go process subtree */
      if parserNodeFirstChild(child, grandchild) <> "" then do:
         run processTree (input child).
      end.
      else do:
         run writeNodeStartElement(input child, input {&dontWriteLineBreak}).
         run writeNodeEndElement(input child).
      end.

      /* get next sibling */
      assign cNodeType = parserNodeNextSibling(child, child).
      
   end.

   /* output endElement */
   run writeNodeEndElement(theNode).
   
   parserReleaseHandle(child).
   parserReleaseHandle(grandchild).
end procedure. /* processTree */


procedure writeNodeStartElement:
/*------------------------------------------------------------------------------
       Purpose:     to write a node start element to the output file
       Parameters:  piNode - the node handle to process        
                    plLineBreak - (logical) output a lineBreak   
       Notes:       
------------------------------------------------------------------------------*/
   define input parameter piNode       as integer     no-undo.
   define input parameter plLineBreak  as logical     no-undo.

   define variable cTag          as character   no-undo.
   
   cTag  =  startElementTag(parserGetNodeType(piNode)).
   cTag  =  substitute(cTag, scrub(parserGetNodeText(piNode))).
   cTag  =  if parserGetNodeLine(piNode) <> 0 then
               addAttribute(cTag, "line",     string(parserGetNodeLine(piNode)))
            else cTag.
   cTag  =  if parserGetNodeColumn(piNode) <> 0 then
               addAttribute(cTag, "column",   string(parserGetNodeColumn(piNode)))
            else cTag.
   cTag  =  addAttribute(cTag, "file",     parserGetNodeFileName(piNode)).
   cTag  =  if parserAttrGet(piNode,"storetype":U) <> "" then
               addAttribute(cTag, "storetype", parserAttrGet(piNode, "storetype"))
            else cTag.
   cTag  =  if parserAttrGet(piNode,"statehead":U) <> "" then
               addAttribute(cTag, "statehead", parserAttrGet(piNode, "statehead"))
            else cTag.
   cTag  =  if parserAttrGet(piNode,"state2":U) <> "" then
               addAttribute(cTag, "state2", parserAttrGet(piNode, "state2"))
            else cTag.
   
   put unformatted cTag.
/*   
   if plLineBreak then 
      put unformatted skip.
*/      
end procedure.

procedure writeNodeEndElement:
/*------------------------------------------------------------------------------
       Purpose:     to write a node end element.
       Parameters:  piNode - the node handle to process 
       Notes:       end tags ALWAYS end with a lineBreak
------------------------------------------------------------------------------*/
   define input parameter piNode as integer     no-undo.

   put unformatted endElementTag(parserGetNodeType(piNode)) skip.
end procedure.

procedure writeXMLHeader:
/*------------------------------------------------------------------------------
       Purpose:     to output standard XML header
       Parameters:  <none>
       Notes:
------------------------------------------------------------------------------*/

   /* output XML declaration */
   put unformatted "<?xml version=~"1.0~" standalone=~"yes~"?>" skip.

   /* output comment block */
   put unformatted "<!--" .
   put unformatted substitute("   XML rendering of proparse tree for &1", filename) .
   put unformatted "-->" skip.

end procedure.

procedure setOutputFile:
/*------------------------------------------------------------------------------
       Purpose:     to designate the output file
       Parameters:  <none>
       Notes:
------------------------------------------------------------------------------*/
  define input parameter p as character no-undo.
  assign
    outfile = p.
end procedure.


procedure setParseFile:
/*------------------------------------------------------------------------------
       Purpose:     to designate the input file
       Parameters:  <none>
       Notes:
------------------------------------------------------------------------------*/
  define input parameter p as character no-undo.
  assign filename = p.
end procedure.