How to Walk the Procedure Call Tree

/* tree.p   This program will show you programs (.p) and include files
**          that your program is running. You should specify how many nested
**          levels you want to go.
** 11/04/96 DMITRI LEVIN (c)
*/

def var PROGR       as char format "x(40)"  no-undo.
def var MAX-LVL     as int  init 2          no-undo.
def var PROG-PATH   as char                 no-undo.
def var PROG-CNT    as int                  no-undo.
def var LVL-CNT     as int                  no-undo.
def var STR         as char format "x(200)" no-undo.
def var TO-FILE     as char init "/users/pedsdal1/tree.out"  
                            format "x(40)" no-undo.
def var OFFSET      as int                  no-undo.

def temp-table PROG-LIST no-undo
    field PROG-NAME as char
    field FULL-PATH as char format "x(40)"
    field LEVEL     as int
    field PROG-NUM  as int
    field PARNT-NUM as int
    field PROCESSED as log
    index PRI       as primary PROG-NUM
    index SEC       PARNT-NUM
    index FPATH     FULL-PATH.

def var SAV-NUM like PROG-LIST.PROG-NUM no-undo.

def stream DMI.
def buffer P-LIST for PROG-LIST.

update 
    PROGR   label "Please, Enter the Program Name  " 
    validate(search(PROGR) <> ?,"Could not find it, try again") skip
    MAX-LVL label "Maximum level of nested programs" 
    help "Usualy more than 3 makes no sence, you can try more later" skip
    TO-FILE label "Send Output to File             "
    help "File name where output 'tree' will be sent"
    with side-labels.

assign
    PROG-CNT = PROG-CNT + 1
    OFFSET = min(int(40 / MAX-LVL),4).

create PROG-LIST.
assign PROG-NAME = PROGR
       FULL-PATH = search(PROGR)
       LEVEL     = LVL-CNT
       PROG-NUM  = PROG-CNT
       PARNT-NUM = 0.

MAIN-LOOP:
do while true on error undo, leave
              on end-key undo, leave:

    find first PROG-LIST where PROG-LIST.PROCESSED = no no-error.
    if not avail PROG-LIST then leave MAIN-LOOP.
    if PROG-LIST.LEVEL >= MAX-LVL
        or PROG-LIST.PROG-NAME matches "applhelp.p"
        or PROG-LIST.PROG-NAME = "RUN VALUE ?"
    then do:
        PROG-LIST.PROCESSED = yes.
        next MAIN-LOOP.
    end.

    input stream DMI from value(PROG-LIST.FULL-PATH).
    LVL-CNT  = PROG-LIST.LEVEL  + 1.
    repeat:
        import stream DMI unformatted str.
 
        if index(str,"run ") > 0 and 
           ( index(str," value(") > 0 or
             index(str," value ") > 0 )
            then do:
                PROG-CNT = PROG-CNT + 1.
                create P-LIST.
                assign P-LIST.PROG-NAME = "RUN VALUE ?"
                       P-LIST.FULL-PATH = "RUN " + str
                       P-LIST.LEVEL     = LVL-CNT
                       P-LIST.PROG-NUM  = PROG-CNT
                       P-LIST.PARNT-NUM = PROG-LIST.PROG-NUM
                       .
                next.
            end.
 
        if index(str,"run") > 0 and ( index(str,".p") > 0 or index(str,".w") > 0 ) then do:
            str = substr(str,index(str,"run") + 4).
            if index(str,".p") > 0 then 
              str = substr(str,1,index(str,".p") + 1).
            else 
              str = substr(str,1,index(str,".w") + 1).
            if search(str) ne ? and not can-find(P-LIST where
                P-LIST.FULL-PATH = search(str) 
                and P-LIST.PARNT-NUM = PROG-LIST.PROG-NUM)
            then do:
                PROG-CNT = PROG-CNT + 1.
                create P-LIST.
                assign P-LIST.PROG-NAME = str
                       P-LIST.FULL-PATH = search(str)
                       P-LIST.LEVEL     = LVL-CNT
                       P-LIST.PROG-NUM  = PROG-CNT
                       P-LIST.PARNT-NUM = PROG-LIST.PROG-NUM
                       .
            end.
        end. /* if index(str,"run") */
        if index(str,chr(123)) > 0 then do:
            str = trim(substr(str,index(str,chr(123)) + 1)).
            if index(str," ") > 0 then str = trim(substr(str,1,index(str," "))).
            if index(str,chr(125)) > 0 
                then str = trim(substr(str,1,index(str,chr(125)) - 1)).
            if search(str) ne ? and not can-find(P-LIST where
                P-LIST.FULL-PATH = search(str)
                and P-LIST.PARNT-NUM = PROG-LIST.PROG-NUM)
            then do:
                PROG-CNT = PROG-CNT + 1.
                create P-LIST.
                assign P-LIST.PROG-NAME = str
                       P-LIST.FULL-PATH = search(str)
                       P-LIST.LEVEL     = LVL-CNT
                       P-LIST.PROG-NUM  = PROG-CNT
                       P-LIST.PARNT-NUM = PROG-LIST.PROG-NUM
                       .
            end.
        end.
    end.
    input stream DMI close.
    PROG-LIST.PROCESSED = yes.
end. /* MAIN-LOOP */

/*
for each PROG-LIST:
    display FULL-PATH prog-num parnt-num level.
end.
*/

output stream DMI to value(TO-FILE).
find PROG-LIST where PROG-LIST.PROG-NUM = 1.
put stream DMI PROG-LIST.FULL-PATH skip.
PROG-LIST.PROCESSED = no.
PRINT-BLOCK:
do while LVL-CNT >= 0:
    LVL-CNT = 0.
    find first P-LIST where P-LIST.PARNT-NUM = PROG-LIST.PROG-NUM
        and P-LIST.PROCESSED = yes
        no-error.
    if avail P-LIST then do:
        assign
            P-LIST.PROCESSED = no
            LVL-CNT = P-LIST.LEVEL.
        put stream DMI space(LVL-CNT * OFFSET) P-LIST.FULL-PATH skip.
        find PROG-LIST where recid(PROG-LIST) = recid(P-LIST).
    end.
    else do:
        find first P-LIST where P-LIST.LEVEL = LVL-CNT 
            and P-LIST.PARNT-NUM = PROG-LIST.PARNT-NUM
            and P-LIST.PROCESSED = yes
            no-error.
        if avail P-LIST then do:
            assign P-LIST.PROCESSED = no.
            put stream DMI space(LVL-CNT * OFFSET) P-LIST.FULL-PATH skip.
            find PROG-LIST where recid(PROG-LIST) = recid(P-LIST).
        end.
        else do:
            assign SAV-NUM = PROG-LIST.PARNT-NUM.
            if SAV-NUM = 0 then leave PRINT-BLOCK.
            find PROG-LIST where PROG-LIST.PROG-NUM = SAV-NUM.
            LVL-CNT = PROG-LIST.LEVEL.
        end.
    end. /* not avail P-LIST*/
end. /* PRINT-BLOCK */
output stream DMI close.