/* proparse/examples/includepath.p
  2006 by Carl Verbiest, CCE NV
  started from scanlister by John Green, Joanju Limited
 
  Scans the source, looks for includes and adds the path (relative to src) to the include name
 
  Known issues
  ============
  * works inside strings as well where it should not (at least not always)
  * not tested for {1} include file parameters
  
  usage
  =====
  RUN proparse/examples/includepath.p PERSISTENT SET scanner.
  RUN setScanFile IN scanner (path + "filename.p").
  RUN setOutputFile IN scanner (newpath + "filename.p").
  RUN main IN scanner.
  APPLY "CLOSE":U TO scanner.
 
 */

DEFINE VARIABLE filename        AS CHARACTER NO-UNDO.
DEFINE VARIABLE outfile         AS CHARACTER NO-UNDO.
DEFINE VARIABLE currnode        AS INTEGER   NO-UNDO.
DEFINE VARIABLE showColumn      AS LOGICAL   NO-UNDO INITIAL TRUE.
DEFINE VARIABLE showLine        AS LOGICAL   NO-UNDO INITIAL TRUE.
DEFINE VARIABLE showWindow      AS LOGICAL   NO-UNDO INITIAL TRUE.

DEFINE VARIABLE parser AS HANDLE NO-UNDO.
RUN proparse/api/proparse.p PERSISTENT SET parser.
{proparse/api/proparse.i parser}

DEF TEMP-TABLE t_Object
    FIELD to_Name AS CHAR
    FIELD to_FixedName AS CHAR
    INDEX t_Object1 IS UNIQUE to_Name
    .

ON "CLOSE":U OF THIS-PROCEDURE DO:
    APPLY "CLOSE":U TO parser.
    DELETE PROCEDURE THIS-PROCEDURE.
END.

RETURN.

FUNCTION FixPath RETURNS CHAR 
    (INPUT i_Name AS CHAR):

    DEFINE VARIABLE l_Pos AS INTEGER     NO-UNDO.
    DEF BUFFER Bt_Object FOR t_Object.

    FIND Bt_Object WHERE Bt_Object.to_Name = i_Name NO-ERROR.
    IF NOT AVAIL Bt_Object 
    THEN DO:
        CREATE Bt_Object. 
        Bt_Object.to_Name = i_Name.
        Bt_Object.to_FixedName = REPLACE(SEARCH(i_Name), "~\", "~/").
        IF Bt_Object.to_FixedName = ? 
        THEN Bt_Object.to_FixedName = i_Name.
        ELSE DO:
            l_Pos = R-INDEX(Bt_Object.to_FixedName, "/src/").
            IF l_Pos > 0 
            THEN Bt_Object.to_FixedName = SUBSTRING(Bt_Object.to_FixedName, l_Pos + 5).
        END.
    END.
    RETURN Bt_Object.to_FixedName.
END FUNCTION.


PROCEDURE main:
    /* Action program for this persistent procedure */
    DEFINE VARIABLE nodeType AS CHARACTER NO-UNDO.
    DEFINE VARIABLE parseNum AS INTEGER NO-UNDO.
    DEFINE VARIABLE l-commentlevel AS INTEGER NO-UNDO.
    DEFINE VARIABLE l-include AS LOGICAL NO-UNDO.
    DEFINE VARIABLE l-filefound AS LOGICAL     NO-UNDO.
    DEFINE VARIABLE l-filename AS CHARACTER   NO-UNDO.
    DEFINE VARIABLE l-ampcount AS INTEGER NO-UNDO.
    OUTPUT TO VALUE(outfile) BINARY NO-CONVERT.
  
    errorblock:
    DO ON ERROR UNDO, LEAVE:
        parseNum = parserParseCreate("scan":U, FILENAME).
        IF parserErrorGetStatus() <> 0 THEN DO:
            MESSAGE parserErrorGetText() VIEW-AS ALERT-BOX ERROR TITLE "Scanner error":T.
            LEAVE errorblock.
        END.
        currnode = parserGetHandle().
        parserParseGetTop(parseNum, currnode).
        nodeType = parserGetNodeType(currNode).
        PARSELOOP:
    DO WHILE nodetype <> "":
      nodeType = parserGetNodeType(currNode).
      IF nodeType = "COMMENTSTART" 
      THEN l-commentlevel = l-commentlevel + 1.
    
      IF l-commentlevel = 0
      THEN DO:
          CASE nodeType:
              WHEN "LEFTCURLY" 
              THEN do:
                  ASSIGN 
                   l-include = YES
                   l-filefound = NO
                   l-filename = "".
                  nodeType = parserNodeNextSibling(currNode, currNode).
                  NEXT PARSELOOP.
              END.
              WHEN "CURLYAMP" THEN l-ampcount = l-ampcount + 1.
              WHEN "RIGHTCURLY" 
              THEN do:
                  IF l-ampcount > 0 THEN l-ampcount = l-ampcount - 1.
              END.
          END CASE.
      END.
    
      IF l-commentlevel = 0 AND l-include AND NOT l-filefound 
      THEN DO:
          IF lookup(nodeType, "WS,RIGHTCURLY,NEWLINE") > 0 AND l-filename <> "" 
          THEN DO:
              l-filefound = YES.
              PUT UNFORMATTED SUBST("~{ &1 ", fixpath(l-filename)).
              IF nodeType = "RIGHTCURLY" 
              THEN DO: 
                  l-include = NO.
                  PUT UNFORMATTED "~}".
              END.
          END.
          ELSE IF LOOKUP(nodeType, "WS,NEWLINE") = 0 
          THEN l-filename = l-filename + parserGetNodeText(currNode).
      END.
      ELSE DO:
          RUN printline.
      END.
    
      IF nodeType = "COMMENTEND" 
      THEN l-commentlevel = l-commentlevel - 1.
    
      nodeType = parserNodeNextSibling(currNode, currNode).
    END.
    END. /* errorblock */
    OUTPUT CLOSE.
    parserParseDelete(parseNum).
END PROCEDURE. /* main */


PROCEDURE printline:
/* Prints one node per line */
  PUT UNFORMATTED
    /*parserGetNodeType(currNode)
    "    ":U*/
    parserGetNodeText(currNode)
    .
/*   MESSAGE parserGetNodeType(currNode) "[" + parserGetNodeText(currNode) + "]" */
/*       VIEW-AS ALERT-BOX INFO BUTTONS OK.                                      */
END PROCEDURE. /* printline */


PROCEDURE setDispAttr:
/* Call this before main to choose attributes to display */
  DEFINE INPUT PARAMETER attrList AS CHARACTER NO-UNDO.
  ASSIGN
    showColumn     = CAN-DO(attrList, "column":U)
    showLine       = CAN-DO(attrList, "linenum":U)
    .
END PROCEDURE.  


PROCEDURE setOutputFile:
/* Call this before main to choose a filename to output to,
   rather than use the result window */
  DEFINE INPUT PARAMETER p AS CHARACTER NO-UNDO.
  ASSIGN
    outfile = p
    showWindow = FALSE.
END PROCEDURE.


PROCEDURE setScanFile:
/* (required) Call this before main to set the scan filename */ 
  DEFINE INPUT PARAMETER p AS CHARACTER NO-UNDO.
  ASSIGN filename = p.
END PROCEDURE.