Par2: Template to print procedures in a project/project tree 2001-03-02 -- Roberto Artigas Jr. #!--------------------------------------------------------------------
#UTILITY(PrintProcNames,'Print Procedure Names')
#!--------------------------------------------------------------------
#! Created By: Roberto Artigas Jr
#! Changes By: Roberto Artigas Jr
#! 1999.01.31: Modifications based on user submited template
#ATSTART
#ENDAT
#!--------------------------------------------------------------------
#ATEND
#ENDAT
#!--------------------------------------------------------------------
#TAB ('Print Procedure Names')
#PROMPT('View "'& %Application & '.pls' &'" after
generation',CHECK),%Viewit,DEFAULT(1),AT(10)
#PROMPT('Print "'& %Application & '.pls' &'" after
generation',CHECK),%PrintQET,DEFAULT(0),AT(10)
#ENABLE(%PRINTQET=1)
#ENABLE(%VIEWIT <> 1)
#PROMPT('Delete "'& %Application & '.pls' &'" after
printing',Check),%KillFile,AT(10)
#ENDENABLE
#ENDENABLE
#ENDTAB
#DISPLAY('Click OK to create "'& %Application & '.pls' &'"')
#CREATE(%Application & '.pls')
#MESSAGE(%Application & '.pls',2)
#DECLARE(%PDate)
#DECLARE(%PTime)
#SET(%PDate,FORMAT(TODAY(),@D02))
#SET(%PTime,FORMAT(CLOCK(),@T06))
List of Procedures (INTERNAL USE) Printed: %PDate - %PTime
=====================================================================
Program: %Application
#SET(%PDate,FORMAT(%ProgramDateChanged,@D02))
#SET(%PTime,FORMAT(%ProgramTimeChanged,@T06))
Date/Time: %PDate - %PTime
#DECLARE(%StatProcList),UNIQUE
#FOR(%Procedure)
#ADD(%StatProcList,%Procedure)
#ENDFOR
Procedure Template Description
Returns Export Prototype
==========================================================
#DECLARE(%Return,STRING)
#DECLARE(%Proto,STRING)
#DECLARE(%Descr,STRING)
#DECLARE(%Temple,STRING)
#DECLARE(%Export,STRING)
#DECLARE(%Position,LONG)
#DECLARE(%LDescr,STRING)
#DECLARE(%LDBeg,LONG)
#DECLARE(%LDEnd,LONG)
#DECLARE(%LDCnt,LONG)
#DECLARE(%LDaSP,LONG)
#DECLARE(%LDaCR,LONG)
#DECLARE(%LDaLF,LONG)
#FOR(%StatProcList)
#FIX(%Procedure,%StatProcList)
#IF(CLIP(%ProcedureDescription)='')
#SET(%Descr,'[No Description]')
#ELSE
#SET(%Descr,%ProcedureDescription)
#ENDIF
#IF(CLIP(%ProcedureReturnType)='')
#SET(%Return,'[No Return]')
#ELSE
#SET(%Position,INSTRING(',NAME',%ProcedureReturnType,1,1))
#IF(%Position)
#SET(%Return,SUB(%ProcedureReturnType,1,%Position-1))
#ELSE
#SET(%Return,%ProcedureReturnType)
#ENDIF
#ENDIF
#IF(CLIP(%Prototype)='')
#SET(%Proto,'[No Prototype]')
#ELSE
#SET(%Position,INSTRING('),',%Prototype,1,1))
#IF(%Position)
#SET(%Proto,SUB(%Prototype,1,%Position))
#ELSE
#SET(%Proto,%Prototype)
#ENDIF
#ENDIF
#IF(%ProcedureExported)
#SET(%Export,'Export')
#ELSE
#SET(%Export,'')
#ENDIF
#SET(%Temple,%ProcedureTemplate)
#MESSAGE('Procedure: ' & %Procedure, 2)
%[25]Procedure %[10]Temple %[40]Descr
%[25]Return %[10]Export %[40]Proto
#INSERT(%PrintLDescr)
#ENDFOR
==========================================================
==========================================================
#CLOSE(%Application & '.pls')
#IF(%PRINTQET=1)
#PRINT(%Application & '.pls', %Application & '.pls - Procedures')
#ENDIF
#IF(%Viewit=1)
#RUN('Write ' & %Application & '.pls')
#ENDIF
#IF(%KillFile=1)
#REMOVE(%Application & '.pls')
#ENDIF
#!
#GROUP(%PrintLDescr)
#IF (%ProcedureLongDescription)
%[15]Null ---- Long Description -----
#IF(LEN(CLIP(%ProcedureLongDescription)) < 60)
%ProcedureLongDescription
#ELSE
#SET(%LDBeg,1)
#SET(%LDEnd,60)
#SET(%LDCnt,0)
#SET(%LDaSP,0)
#SET(%LDaCR,0)
#SET(%LDaLF,0)
#LOOP UNTIL(%LDBeg>LEN(CLIP(%ProcedureLongDescription)))
#SET(%LDescr,SUB(%ProcedureLongDescription,%LDBeg,%LDEnd))
#SET(%LDaCR,INSTRING('<13>',%LDescr,1,1))
#IF (%LDaCR)
#IF(%LDaCR < %LDEnd)
#SET(%LDEnd,%LDaCR)
#ENDIF
#ENDIF
#SET(%LDaLF,INSTRING('<10>',%LDescr,1,1))
#IF (%LDaLF)
#IF(%LDaLF < %LDEnd)
#SET(%LDEnd,%LDaLF)
#ENDIF
#ENDIF
#LOOP FOR(%LDCnt,1,60)
#IF(SUB(%LDescr,%LDCnt,1)=' ')
#SET(%LDaSp,%LDCnt)
#ENDIF
#ENDLOOP
#IF(%LDaSP < %LDEnd)
#IF (%LDaCR)
#ELSIF(%LDaLF)
#ELSE
#SET(%LDEnd,%LDaSP)
#ENDIF
#ENDIF
#SET(%LDescr,SUB(%ProcedureLongDescription,%LDBeg,%LDEnd))
%LDescr
#SET(%LDBeg,%LDBeg+%LDEnd)
#IF(%LDaCR)
#SET(%LDBeg,%LDBeg+1)
#END
#! #IF(%LDaLF)
#! #SET(%LDBeg,%LDBeg+1)
#! #END
#SET(%LDEnd,60)
#ENDLOOP
#ENDIF
#ENDIF
#!
#!--------------------------------------------------------------------
#!--------------------------------------------------------------------
#!--------------------------------------------------------------------
#UTILITY(PrintProcTree,'Print Procedure Tree')
#!--------------------------------------------------------------------
#! Note: Does NOT handle Procedure Recursion
#! Created By: ?
#!
#ATSTART
#ENDAT
#!--------------------------------------------------------------------
#ATEND
#ENDAT
#!--------------------------------------------------------------------
#TAB ('Print Procedure Tree')
#PROMPT('Print AppProc.Txt after it is
generated',CHECK),%PrintQET,DEFAULT(1),AT(10)
#PROMPT('View AppProc.Txt after generation',CHECK),%Viewit,DEFAULT(1),AT(10)
#ENABLE(%PRINTQET=1)
#ENABLE(%VIEWIT <> 1)
#PROMPT('Delete AppProc.Txt After Printing',Check),%KillFile,AT(10)
#ENDENABLE
#ENDENABLE
#ENDTAB
#DISPLAY('Click OK to create AppProc.Txt')
#CREATE('AppProc.Txt')
#MESSAGE('Creating AppProc.Txt',2)
Print Procedure Tree
======================================
(PROGRAMMER INTERNAL USE ONLY)
======================================
======================================
Program: %Application
Dictionary: %DictionaryFile
#INSERT(%DisplayTree,%FirstProcedure,'',' ')
Global Variables
======================================
#FOR(%GlobalData)
%[25]GlobalData %GlobalDataStatement
#ENDFOR
======================================
======================================
#CLOSE('AppProc.Txt')
#IF(%PRINTQET=1)
#PRINT('AppProc.Txt','Procedure Names')
#ENDIF
#IF(%Viewit=1)
#RUN('Write AppProc.Txt')
#ENDIF
#IF(%KillFile=1)
#REMOVE('AppProc.Txt')
#ENDIF
#!
#GROUP(%DisplayTree,%ThisProc,%Level,%NextIndent)
#FIX(%Procedure,%ThisProc)
%Level+-%ThisProc (%ProcedureTemplate) %ProcedureDescription
#FOR(%ProcedureCalled)
#IF(INSTANCE(%ProcedureCalled)=ITEMS(%ProcedureCalled))
#INSERT(%DisplayTree,%ProcedureCalled,%Level&%NextIndent,' ')
#ELSE
#INSERT(%DisplayTree,%ProcedureCalled,%Level&%NextIndent,'|')
#ENDIF
#ENDFOR
#!
Printed April 28, 2024, 6:07 pm This article has been viewed/printed 35138 times. |