` Printed Icetips Article

Icetips Article



Templates: Template to write templates
1999-02-25 -- Vince Sorensen
 
Newsgroups: TopSpeed.Topic.Templates

Editors note:  Please note that some lines may wrap in the template code.

#TEMPLATE (SmartPrintUtilities, 'The Smart Print Utilities')
#!*****************************************************************************
#! Version: 1.5
#!
#! Author: George Petrov
#! Dated : 11.05.1996
#! e-Mail: George.Petrov@Princen-IT.nl or 100276,2655 at CompuServe
#!
#!
#!*****************************************************************************
#UTILITY(GenerateTemplates, 'Generate Template code from All Embeds'),WIZARD
#!*****************************************************************************
#!
#SHEET
  #TAB('Template Generation Wizard')
    #IMAGE('PRINTDCT.BMP')
    #DISPLAY('This wizard will generate a full functional template from the contents of
your current application.'),AT(90,8,235,24)
    #DISPLAY('To specify how the template must be generated, click on the Next
button.'),AT(90)
  #ENDTAB
  #TAB('Template Generation Wizard - Output File'),FINISH(1)
    #IMAGE('PRINTDCT.BMP')
    #PROMPT('What name do you want the template file to
have?',OPTION),%WhatName,AT(90,8,235,70)
    #PROMPT('Use the application name, with a .TPL extension.',RADIO),AT(100,,224)
    #PROMPT('Let me supply my own file name.',RADIO),AT(100)
    #ENABLE(%WhatName = 'Let me supply my own file name.')
      #PROMPT('Please enter the name of the template file to be
generated.',@S100),%NewName,AT(100,52,215),PROMPTAT(100,40,215)
    #ENDENABLE
  #ENDTAB
  #TAB('Template Generation Wizard - Procedures to be used'),FINISH(1)
    #IMAGE('PRINTDCT.BMP')
    #DISPLAY('You can generate template from all procedures in your application, or you
can select individual procedures.'),AT(90,8,235,24)
    #PROMPT('Generate templates from all my
procedures.',CHECK),%TemplateUseAllProcedures,AT(90,,180),DEFAULT(1)
    #DISPLAY('')
    #PROMPT('Generate template code from global embeds.',
CHECK),%TemplateUseGlobal,AT(90,,180),DEFAULT(1)
  #ENDTAB
  #TAB('Template Generation Wizard - Select Procedures'),WHERE(NOT
%TemplateUseAllProcedures),FINISH(1)
    #IMAGE('PRINTDCT.BMP')
    #PROMPT('Procedure
Selection',FROM(%Procedure)),%TemplateUseProcedureSelection,INLINE,SELECTION('Procedure
Selection'),AT(90,8,235)
  #ENDTAB
  #TAB('Template Generation Wizard - Finally...')
    #IMAGE('PRINTDCT.BMP')
    #DISPLAY('This concludes the template generation wizard.'),AT(90,8,235,24)
    #DISPLAY('Click on the Finish button to generate the template
file.'),AT(90,82,235,24)
  #ENDTAB
#ENDSHEET
#!
#DECLARE(%SaveToFile)
#!
#IF(%WhatName = 'Use the application name, with a .TPL extension.')
  #SET(%SaveToFile,%Application & '.TPL')
#ELSE
  #SET(%SaveToFile,%NewName)
#ENDIF
#!
#! Template Variables
#!
#DECLARE(%ASCIIFileRecord)
#DECLARE(%InstancePrefix)
#DECLARE(%InstanceQueue),MULTI
#DECLARE(%TempDescription)
#DECLARE(%Today)
#DECLARE(%AutoTemplateName)
#DECLARE(%ConstructAT)
#DECLARE(%PreviousAT)
#DECLARE(%GenerateTemplate)
#DECLARE(%ReqGlobalExtension)
#DECLARE(%SkipProcedure)
#!
#! Initialization
#!
#SET(%GenerateTemplate,%True)
#SET(%Today,FORMAT(TODAY(),@D1))
#SET(%AutoTemplateName, %Application & '_Template')
#!
#CREATE(%SaveToFile)
#MESSAGE(%Application,0)
%#TEMPLATE (%AutoTemplateName, 'Generated %Application Template')
%#!*****************************************************************************
%#! Version: 1.0
%#!
%#! Author: ...
%#! Dated : %Today
%#!
%#! NOTE: Auto-generated template code based on %Application
%#!
%#!*****************************************************************************
%#!
#FOR(%Module)
#SUSPEND
#CREATE(%Application & '.$$$')
#MESSAGE('Module: ' & %Module,1)
#EXPORT(%Module)
#CLOSE(%Application & '.$$$')
#OPEN(%Application & '.$$$'),READ
#IF(%ModuleBase = %Application AND %TemplateUseGlobal)
%#!
%#!*****************************************************************************
%#EXTENSION(%Application,'Global Extension for
%Application'),APPLICATION
%#!*****************************************************************************
%#!
#ENDIF
#IF(NOT %TemplateUseGlobal)
    #SET(%SkipProcedure,%True)
#ENDIF
#LOOP
    #READ(%ASCIIFileRecord)
    #IF(%ASCIIFileRecord = %EOF OR %ASCIIFileRecord = '[END]')
        #BREAK
    #ELSIF(%ASCIIFileRecord = '[PROCEDURE]')
        #READ(%ASCIIFileRecord)

#FIX(%Procedure,SUB(%ASCIIFileRecord,6,LEN(%ASCIIFileRecord)-5))
        #SET(%SkipProcedure,%False)
        #IF(NOT %TemplateUseAllProcedures)
            #FIX(%TemplateUseProcedureSelection,%Procedure)
            #IF(NOT %TemplateUseProcedureSelection)
                #SET(%SkipProcedure,%True)
            #ENDIF
        #ENDIF
        #IF(NOT %SkipProcedure)
            #MESSAGE('Exporting Embeds: ' & %Procedure,2)
            #! Check for description
            #SET(%TempDescription,%ProcedureDescription)
            #IF(%TempDescription <> '')
                #SET(%TempDescription,'Procedure Extension: ' & %TempDescription)
            #ELSE
                #SET(%TempDescription,'Procedure Extension for ' & %Procedure)
            #ENDIF
            #IF(%TemplateUseGlobal)
                #SET(%ReqGlobalExtension,',REQ(' & %Application & ')')
            #ELSE
                #SET(%ReqGlobalExtension,'')
            #ENDIF
#?%#!
#?%#!*****************************************************************************
#?%#EXTENSION(%Procedure,'%TempDescription'),PROCEDURE
%ReqGlobalExtension
#?%#!*****************************************************************************
#?%#!
        #ENDIF
    #ELSIF(%ASCIIFileRecord = '[EMBED]')
        #FREE(%InstanceQueue)
#INSERT(%GetSection,%False)
    #ENDIF
#ENDLOOP
#CLOSE(%Application & '.$$$'),READ
#RESUME
#ENDFOR
#CLOSE
#REMOVE(%Application & '.$$$')
#!
#!=============================================================================
#GROUP(%TplGetDefinitionSection)
#SUSPEND
#LOOP
    #READ(%ASCIIFileRecord)
    #CASE(%ASCIIFileRecord)
    #OF('[END]')
        #BREAK
    #OF('[SOURCE]')
        #IF(%SkipProcedure)
            #CYCLE
        #ENDIF
    #!OROF('[PROCEDURE]')
    #!OROF('[GROUP]')
        #SET(%ConstructAT,'#AT(')
        #FOR(%InstanceQueue)
            #CASE(SUB(LEFT(%InstanceQueue),1,5))
            #OF('EMBED')
                #SET(%ConstructAT,%ConstructAT &
SUB(LEFT(CLIP(%InstanceQueue)),7,LEN(LEFT(CLIP(%InstanceQueue)))-6))
            #OF('WHEN ')
                #SET(%ConstructAT,%ConstructAT & ',' &
SUB(LEFT(CLIP(%InstanceQueue)),6,LEN(LEFT(CLIP(%InstanceQueue)))-5))
            #ENDCASE
        #ENDFOR
        #SET(%ConstructAT,%ConstructAT & ')')
        #IF(%PreviousAT <> %ConstructAT)
%#!
%#!=============================================================================
#?%ConstructAT
%#!-----------------------------------------------------------------------------
%#!
        #ENDIF
        #SET(%PreviousAT,%ConstructAT)
    #ENDCASE
    #IF(%SkipProcedure)
        #CYCLE
    #ENDIF
#IF(SUB(%ASCIIFileRecord,1,1) <> '[')
    #CASE(%ASCIIFileRecord)
    #OF('PROPERTY:BEGIN')
    #OF('PROPERTY:END')
    #ELSE
#IF(SUB(%ASCIIFileRecord,1,8) <> 'PRIORITY')
%ASCIIFileRecord
#ELSE
! *** %ASCIIFileRecord ***
#ENDIF
    #ENDCASE
#ENDIF
#ENDLOOP
#?%#ENDAT
#RESUME
#!
#!=============================================================================
#!
#!*****************************************************************************
#UTILITY(PrintAllEmbeds, 'Print All Embeds'),WIZARD
#!*****************************************************************************
#!
#SHEET
  #TAB('Print All Embeds Wizard')
    #IMAGE('PRINTDCT.BMP')
    #DISPLAY('This wizard will dump all your Embeds to a file and optionaly print
it.'),AT(90,8,235,24)
    #DISPLAY('To specify what exactly you want to be printed, click on the Next
button.'),AT(90)
  #ENDTAB
  #TAB('Print All Embeds Wizard - Output File'),FINISH(1)
    #IMAGE('PRINTDCT.BMP')
    #PROMPT('What name do you want embeds file to
have?',OPTION),%WhatName,AT(90,8,235,70)
    #PROMPT('Use the application name, with a .EMB extension.',RADIO),AT(100,,224)
    #PROMPT('Let me supply my own file name.',RADIO),AT(100)
    #ENABLE(%WhatName = 'Let me supply my own file name.')
      #PROMPT('Please enter the name of the embeds
file.',@S100),%NewName,AT(100,52,215),PROMPTAT(100,40,215)
    #ENDENABLE
  #ENDTAB
  #TAB('Print All Embeds Wizard - Procedures to be used'),FINISH(1)
    #IMAGE('PRINTDCT.BMP')
    #DISPLAY('You can dump the embeds from all procedures in your application, or you can
select individual procedures.'),AT(90,8,235,24)
    #PROMPT('Dump embeds from all my
procedures.',CHECK),%TemplateUseAllProcedures,AT(90,,180),DEFAULT(1)
    #DISPLAY('')
    #PROMPT('Dump global embeds code.', CHECK),%TemplateUseGlobal,AT(90,,180),DEFAULT(1)
  #ENDTAB
  #TAB('Print All Embeds Wizard - Select Procedures'),WHERE(NOT
%TemplateUseAllProcedures),FINISH(1)
    #IMAGE('PRINTDCT.BMP')
    #PROMPT('Procedure
Selection',FROM(%Procedure)),%TemplateUseProcedureSelection,INLINE,SELECTION('Procedure
Selection'),AT(90,8,235)
  #ENDTAB
  #TAB('Print All Embeds Wizard - Print Options')
    #IMAGE('PRINTDCT.BMP')
    #DISPLAY('')
    #PROMPT('Print the file after generation',CHECK),%DirectPrint,DEFAULT(0),AT(90,,180)
    #DISPLAY('')
    #PROMPT('Put every procedure on a new
page',CHECK),%ProcedureNewPage,DEFAULT(1),AT(90,,180)
  #ENDTAB
  #TAB('Print All Embeds Wizard - Finally...')
    #IMAGE('PRINTDCT.BMP')
    #DISPLAY('This concludes the embeds print wizard.'),AT(90,8,235,24)
    #DISPLAY('Click on the Finish button to generate the template
file.'),AT(90,82,235,24)
  #ENDTAB
#ENDSHEET
#!
#DECLARE(%SaveToFile)
#!
#IF(%WhatName = 'Use the application name, with a .EMB extension.')
  #SET(%SaveToFile,%Application & '.EMB')
#ELSE
  #SET(%SaveToFile,%NewName)
#ENDIF
#!
#! Template Variables
#!
#DECLARE(%ASCIIFileRecord)
#DECLARE(%InstancePrefix)
#DECLARE(%InstanceQueue),MULTI
#DECLARE(%FormFeed)
#DECLARE(%TempDescription)
#DECLARE(%GenerateTemplate)
#DECLARE(%SkipProcedure)
#!
#! Initialization
#!
#SET(%FormFeed,'<12>')
#SET(%GenerateTemplate,%False)
#!
#CREATE(%SaveToFile)
#MESSAGE(%Application,0)
Embeds for %Application

#FOR(%Module)
#SUSPEND
#CREATE(%Application & '.$$$')
#MESSAGE('Module: ' & %Module,1)
#EXPORT(%Module)
#CLOSE(%Application & '.$$$')
#OPEN(%Application & '.$$$'),READ
#IF(%ModuleBase = %Application AND %TemplateUseGlobal)
#?!*****************************************************************************
#?! MODULE: %Module - %ModuleTemplate
#?!*****************************************************************************
#ENDIF
#IF(NOT %TemplateUseGlobal)
    #SET(%SkipProcedure,%True)
#ENDIF
#LOOP
    #READ(%ASCIIFileRecord)
    #IF(%ASCIIFileRecord = %EOF OR %ASCIIFileRecord = '[END]')
        #BREAK
    #ELSIF(%ASCIIFileRecord = '[PROCEDURE]')
        #READ(%ASCIIFileRecord)

#FIX(%Procedure,SUB(%ASCIIFileRecord,6,LEN(%ASCIIFileRecord)-5))
        #SET(%SkipProcedure,%False)
        #IF(NOT %TemplateUseAllProcedures)
            #FIX(%TemplateUseProcedureSelection,%Procedure)
            #IF(NOT %TemplateUseProcedureSelection)
                #SET(%SkipProcedure,%True)
            #ENDIF
        #ENDIF
        #IF(NOT %SkipProcedure)
            #MESSAGE('Exporting Embeds: ' & %Procedure,2)
            #! Check for decription
            #SET(%TempDescription,%ProcedureDescription)
            #IF(%TempDescription <> '')
                #SET(%TempDescription,'- ' & %TempDescription)
            #ENDIF
#?!*****************************************************************************
#?! PROCEDURE: %Procedure (%ProcedureTemplate) %TempDescription
#?!*****************************************************************************
#?
        #ENDIF
    #ELSIF(%ASCIIFileRecord = '[EMBED]')
        #FREE(%InstanceQueue)
#INSERT(%GetSection,%False)
    #ENDIF
#ENDLOOP
#CLOSE(%Application & '.$$$'),READ
#IF(%ProcedureNewPage)
#?%FormFeed
#ENDIF
#RESUME
#ENDFOR
#CLOSE
#REMOVE(%Application & '.$$$')
#IF(%DirectPrint)
    #PRINT(%SaveToFile,'All Embeds for ' & %Application)
#ENDIF
#!=============================================================================
#GROUP(%GetSection,%AddToEmbedTree)
#READ(%ASCIIFileRecord)
#ADD(%InstanceQueue,%ASCIIFileRecord)
#INSERT(%LoopSections,%AddToEmbedTree)
#!=============================================================================
#GROUP(%GetDefinitionSection)
#LOOP
    #READ(%ASCIIFileRecord)
    #CASE(%ASCIIFileRecord)
    #OF('[END]')
        #BREAK
    #OF('[SOURCE]')
    #OROF('[PROCEDURE]')
    #OROF('[GROUP]')
        #IF(%SkipProcedure)
            #CYCLE
        #ENDIF
!=============================================================================
        #SET(%InstancePrefix,'')
        #FOR(%InstanceQueue)
%InstancePrefix %InstanceQueue
            #SET(%InstancePrefix,%InstancePrefix & '    ')
        #ENDFOR
!-----------------------------------------------------------------------------
    #ENDCASE
    #IF(%SkipProcedure)
        #CYCLE
    #ENDIF
%ASCIIFileRecord
#ENDLOOP
#!=============================================================================
#GROUP(%LoopSections,%DeleteInstance)
#LOOP
    #READ(%ASCIIFileRecord)
    #IF(%ASCIIFileRecord = %EOF)
        #BREAK
    #ENDIF
    #CASE(%ASCIIFileRecord)
    #OF('[END]')
        #IF(%DeleteInstance AND ITEMS(%InstanceQueue) >= 1)
            #DELETE(%InstanceQueue,ITEMS(%InstanceQueue))
        #ENDIF
        #BREAK
    #OF('[INSTANCES]')
#INSERT(%GetSection,%True)
    #OF('[DEFINITION]')
        #IF(%GenerateTemplate)
#INSERT(%TplGetDefinitionSection)
        #ELSE
#INSERT(%GetDefinitionSection)
        #ENDIF
    #ELSE
        #IF(SUB(%ASCIIFileRecord,1,6) = 'EMBED ')
            #IF(ITEMS(%InstanceQueue) >= 1)
                #DELETE(%InstanceQueue,ITEMS(%InstanceQueue))
            #ENDIF
            #ADD(%InstanceQueue,%ASCIIFileRecord)
            #SET(%DeleteInstance,%False)
        #ELSIF(SUB(%ASCIIFileRecord,1,5) = 'WHEN ')
            #IF(ITEMS(%InstanceQueue) >= 1)
                #DELETE(%InstanceQueue,ITEMS(%InstanceQueue))
            #ENDIF
            #ADD(%InstanceQueue,%ASCIIFileRecord)
            #SET(%DeleteInstance,%True)
        #ENDIF
    #ENDCASE
#ENDLOOP
#!
#!*****************************************************************************
#UTILITY(PrintAllHelpID, 'Print All Help ID''s')
#!*****************************************************************************
#!
#DISPLAY('This Utility will dump all your Help ID''s to a file.')
#DISPLAY('')
#PROMPT('Save to File:',SAVEDIALOG('Pick File','Help ID''s|*.HID')),%SaveToFile
#PREPARE
    #SET(%SaveToFile,%Application & '.HID')
#ENDPREPARE
#DISPLAY('')
#PROMPT('Print the file after generation',CHECK),%DirectPrint,DEFAULT(0),AT(10)
#DISPLAY('')
#PROMPT('Put every procedure on a new page',CHECK),%ProcedureNewPage,DEFAULT(1),AT(10)
#PROMPT('Print each control even if there is no HELP
ID',CHECK),%PrintAllControls,DEFAULT(1),AT(10)
#PROMPT('Print CONTROL''s Type',CHECK),%PrintType,DEFAULT(1),AT(20)
#PROMPT('Print CONTROL''s Message',CHECK),%PrintMessage,DEFAULT(1),AT(20)
#PROMPT('Print CONTROL''s ToolTip',CHECK),%PrintToolTip,DEFAULT(1),AT(20)
#DECLARE(%FormFeed)
#DECLARE(%HlpIndent)
#DECLARE(%HCounter)
#DECLARE(%ControlHelpID)
#DECLARE(%ControlMessage)
#DECLARE(%ControlToolTip)
#!
#SET(%FormFeed,'<12>')
#CREATE(%SaveToFile)
#MESSAGE(%Application,0)
Help ID's: for %Application
#FOR(%Procedure)
#MESSAGE('Exporting Help ID''s: ' & %Procedure,2)
#SUSPEND
#?
#?!*****************************************************************************
#?%Procedure (%ProcedureTemplate)
#?!*****************************************************************************
#?
#FOR(%Control)
    #SET(%ControlHelpID,EXTRACT(%ControlStatement,'HLP',1))
    #SET(%ControlMessage,EXTRACT(%ControlStatement,'MSG',1))
    #SET(%ControlToolTip,EXTRACT(%ControlStatement,'TIP',1))
    #IF(%ControlHelpID <> '' OR %PrintAllControls)
        #! There is HelpID
        #SET(%HlpIndent,'')
        #LOOP,FOR(%HCounter,0,%ControlIndent)
            #SET(%HlpIndent,%HlpIndent & '    ')
        #ENDLOOP
#IF(%PrintType)
%HlpIndent %ControlType: %Control
#ELSE
%HlpIndent %Control
#ENDIF
#IF(%PrintMessage)
%HlpIndent    MSG: %ControlMessage
#ENDIF
#IF(%PrintToolTip)
%HlpIndent    TIP: %ControlToolTip
#ENDIF
%HlpIndent    HLP: %ControlHelpID
    #ENDIF
#ENDFOR
#IF(%ProcedureNewPage)
#?%FormFeed
#ENDIF
#RESUME
#ENDFOR
#CLOSE
#IF(%DirectPrint)
    #PRINT(%SaveToFile,'All Help ID''s for ' & %Application)
#ENDIF
#!
#!*****************************************************************************
#UTILITY(PrintProcedureTree, 'Print Procedure Tree')
#!*****************************************************************************
#!
#DISPLAY('This Utility will generate the procedure tree to a text file.')
#DISPLAY('')
#PROMPT('Save to File:',SAVEDIALOG('Pick File','Procedure Tree|*.PTR')),%SaveToFile
#PREPARE
    #SET(%SaveToFile,%Application & '.PTR')
#ENDPREPARE
#DISPLAY('')
#PROMPT('Print the file after generation',CHECK),%DirectPrint,DEFAULT(0),AT(10)
#DISPLAY('')
#PROMPT('Does not print already expanded
procedures',CHECK),%NoPrintExpandedProc,DEFAULT(1),AT(10)
#PREPARE
    #IF(%NoPrintExpandedProc = 1)
        #SET(%ProcedureNewPage,0)
    #ENDIF
#ENDPREPARE
#ENABLE(%NoPrintExpandedProc = 0)
#PROMPT('Put every procedure tree on a new
page',CHECK),%ProcedureNewPage,DEFAULT(1),AT(20)
#ENDENABLE
#PROMPT('Use Graphics',CHECK),%UseGraphics,DEFAULT(1),AT(10)
#ENABLE(%UseGraphics = 1)
#PROMPT('Use ASCII graphical characters',CHECK),%ASCIIGraph,DEFAULT(1),AT(20)
#ENDENABLE
#INSERT(%ASCIICheck)
#DECLARE(%ProcedureExpanded,%Procedure)
#DECLARE(%FormFeed)
#SET(%FormFeed,'<12>')
#CREATE(%SaveToFile)
#MESSAGE(%Application,0)
Procedure Tree for %Application
#FOR(%Procedure),WHERE(ITEMS(%ProcedureCalled) > 0 AND (%ProcedureExpanded = %False OR NOT
%NoPrintExpandedProc))
#MESSAGE('Generating: ' & %Procedure,2)

#INSERT(%PrintProcedure,%Procedure,'','    ')
#IF(%ProcedureNewPage)
%FormFeed
#ENDIF
#ENDFOR
#CLOSE
#IF(%DirectPrint)
    #PRINT(%SaveToFile,'Procedure Tree for ' & %Application)
#ENDIF
#!
#GROUP(%PrintProcedure,%ProcedureToPrint,%ProcedureIndent,%NextIndent)
#DECLARE(%ProcSeparator)
    #FIX(%Procedure,%ProcedureToPrint)
    #SET(%ProcedureExpanded, %True)
    #IF(CLIP(%NextIndent) = '')
        #SET(%ProcSeparator,%CharBL & %CharMin)
    #ELSE
        #SET(%ProcSeparator,%CharTL & %CharMin)
    #ENDIF
    #IF(LEN(%ProcedureIndent) = 0)
        #SET(%ProcSeparator,'*' & %CharMin)
    #ENDIF
    #IF(%ProcedureDescription)
%ProcedureIndent %ProcSeparator %ProcedureToPrint (%ProcedureTemplate)
- %ProcedureDescription
    #ELSE
%ProcedureIndent %ProcSeparator %ProcedureToPrint (%ProcedureTemplate)
    #ENDIF
#FOR(%ProcedureCalled)
    #IF(%Procedure)
        #IF(INSTANCE(%ProcedureCalled) = ITEMS(%ProcedureCalled))
#INSERT(%PrintProcedure,%ProcedureCalled,%ProcedureIndent & %NextIndent, '     ')
        #ELSE
#INSERT(%PrintProcedure,%ProcedureCalled,%ProcedureIndent & %NextIndent, ' ' & %CharPipe &
'   ')
        #ENDIF
    #ENDIF
#ENDFOR
#!
#GROUP(%ASCIICheck)
#DECLARE(%CharTL)
#DECLARE(%CharMin)
#DECLARE(%CharBL)
#DECLARE(%CharPipe)
#!
#IF(%UseGraphics)
    #IF(%ASCIIGraph)
        #SET(%CharTL,  'Ã')
        #SET(%CharMin, 'Ä')
        #SET(%CharBL,  'À')
        #SET(%CharPipe,'³')
    #ELSE
        #SET(%CharTL,  '+')
        #SET(%CharMin, '-')
        #SET(%CharBL,  '+')
        #SET(%CharPipe,'|')
    #ENDIF
#ELSE
    #SET(%CharTL,  ' ')
    #SET(%CharMin, ' ')
    #SET(%CharBL,  ' ')
    #SET(%CharPipe,' ')
#ENDIF
#!
#!*****************************************************************************
#UTILITY(PrintFileRelationsTree, 'Print File Relations Tree')
#!*****************************************************************************
#!
#DISPLAY('This Utility will generate the file relations tree to a text file.')
#DISPLAY('')
#PROMPT('Save to File:',SAVEDIALOG('Pick File','File Relations Tree|*.FTR')),%SaveToFile
#PREPARE
    #SET(%SaveToFile,%Application & '.FTR')
#ENDPREPARE
#DISPLAY('')
#PROMPT('Print the file after generation',CHECK),%DirectPrint,DEFAULT(0),AT(10)
#DISPLAY('')
#PROMPT('Does not print already expanded
files',CHECK),%NoPrintExpandedFile,DEFAULT(1),AT(10)
#PREPARE
    #IF(%NoPrintExpandedFile = 1)
        #SET(%FileNewPage,0)
    #ENDIF
#ENDPREPARE
#ENABLE(%NoPrintExpandedFile = 0)
#PROMPT('Put every file relations tree on a new
page',CHECK),%FileNewPage,DEFAULT(1),AT(20)
#ENDENABLE
#PROMPT('Use Graphics',CHECK),%UseGraphics,DEFAULT(1),AT(10)
#ENABLE(%UseGraphics = 1)
#PROMPT('Use ASCII graphical characters',CHECK),%ASCIIGraph,DEFAULT(1),AT(20)
#ENDENABLE
#INSERT(%ASCIICheck)
#DECLARE(%FileExpanded,%File)
#DECLARE(%FormFeed)
#SET(%FormFeed,'<12>')
#CREATE(%SaveToFile)
#MESSAGE(%Application,0)
File Relations Tree for %Application, dictionary %DictionaryFile
#FOR(%File),WHERE(ITEMS(%Relation) > 0 AND (%FileExpanded = %False OR NOT
%NoPrintExpandedFile))
#MESSAGE('Generating: ' & %File,2)

#INSERT(%PrintFile,%File,'','    ')
#IF(%FileNewPage)
%FormFeed
#ENDIF
#ENDFOR
#CLOSE
#IF(%DirectPrint)
    #PRINT(%SaveToFile,'File Relations Tree for ' & %Application & ', dictionary ' &
%DictionaryFile)
#ENDIF
#!
#GROUP(%PrintFile,%FileToPrint,%FileIndent,%NextIndent)
#DECLARE(%FileSeparator)
#DECLARE(%LastFile)
#DECLARE(%FileCounter)
#DECLARE(%SaveRelation)
    #FIX(%File,%FileToPrint)
    #SET(%FileExpanded, %True)
    #IF(CLIP(%NextIndent) = '')
        #SET(%FileSeparator,%CharBL & %CharMin)
    #ELSE
        #SET(%FileSeparator,%CharTL & %CharMin)
    #ENDIF
    #IF(LEN(%FileIndent) = 0)
        #SET(%FileSeparator,'*' & %CharMin)
    #ENDIF
    #IF(%FileDescription)
%FileIndent %FileSeparator %FileToPrint - %FileDescription
    #ELSE
%FileIndent %FileSeparator %FileToPrint
    #ENDIF
#FOR(%Relation),WHERE(%FileRelationType = '1:MANY')
    #IF(%File)
        #SET(%SaveRelation,INSTANCE(%Relation))
        #SET(%LastFile,%True)
        #LOOP,FOR(%FileCounter,INSTANCE(%Relation)+1,ITEMS(%Relation))
            #SELECT(%Relation,%FileCounter)
            #IF(%FileRelationType = '1:MANY')
                #SET(%LastFile,%False)
                #BREAK
            #ENDIF
        #ENDLOOP
        #SELECT(%Relation,%SaveRelation)
        #IF(%LastFile)
#INSERT(%PrintFile,%Relation,%FileIndent & %NextIndent, '     ')
        #ELSE
#INSERT(%PrintFile,%Relation,%FileIndent & %NextIndent, ' ' &
%CharPipe & '   ')
        #ENDIF
    #ENDIF
#ENDFOR
#!



Printed November 21, 2024, 6:39 am
This article has been viewed/printed 35264 times.
Google search has resulted in 47 hits on this article since January 25, 2004.