` Template to print procedures in a project/project tree (Roberto Artigas Jr. ) - Icetips Article
Icetips - Templates, Tools & Utilities for Clarion Developers

Templates, Tools and Utilities
for Clarion Developers

Icetips Article

Back to article list   Search Articles     Add Comment     Printer friendly     Direct link  

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 #!

Today is November 21, 2024, 8:13 am
This article has been viewed 35261 times.


Back to article list   Search Articles   Add Comment   Printer friendly

Login

User Name:

Password:


Gold Subscription
Buy Now
Silver Subscription
Buy Now
Solo Subscription
Buy Now
Multiple Copy Pricing
Renew Subscription