Templates: Finding orphaned embed points
2002-03-05 -- Peter Gysegem
Newsgroups: comp.lang.clarion
Don't remember where I got it but here is a utility template for finding
orphaned embeds.
#!-------------------------------------------------------------------------
#UTILITY(FindOrphaned,'2001.01.12: Find Orphaned #EMBEDS in application')
#!-------------------------------------------------------------------------
#BOXED('')
#DISPLAY('')
#DISPLAY('Find all orphaned embed points in source')
#DISPLAY('')
#PROMPT('Output File:',@S40),%OutputFile,REQ,DEFAULT(CLIP(UPPER(%Application)) &
'.ORF')
#DISPLAY('')
#DISPLAY('From: Eric Griset <')
#DISPLAY('Newsgroups: TopSpeed.Topic.Templates')
#DISPLAY('')
#ENDBOXED
#!--------------------------------------------------------------------
#DECLARE(%TXAFile)
#DECLARE(%TXARecord)
#SET(%TXAFile,(UPPER(%Application) & '.B2$'))
#!--------------------------------------------------------------------
#DECLARE(%Sections),MULTI
#DECLARE(%InEmbed)
#DECLARE(%InstancesLevel)
#DECLARE(%Embeds),MULTI
#DECLARE(%ControlsWithEmbeds,%Embeds),UNIQUE
#DECLARE(%ControlsWithEmbeds2,%ControlsWithEmbeds),UNIQUE
#DECLARE(%ControlsWithEmbeds3,%ControlsWithEmbeds2),UNIQUE
#DECLARE(%ProcNamePrinted)
#DECLARE(%EmbedNamePrinted)
#DECLARE(%FoundOrphans)
#!
#DECLARE(%PosibleEmbed)
#DECLARE(%PosibleEmbed1)
#DECLARE(%PosibleEmbed2)
#DECLARE(%PosibleEmbed3)
#!
#MESSAGE('Find orphaned embed points',0)
#MESSAGE('Application: ' & %Application,1)
#SET(%FoundOrphans,%False)
#CREATE(%OutputFile)
#!
Orphaned #EMBED found Report
======================================
(PROGRAMMER INTERNAL USE ONLY)
======================================
Application: %Application
#FOR(%Procedure)
#MESSAGE('Procedure: ' & %Procedure,2)
#FREE(%Sections)
#CREATE(%TXAFile)
#EXPORT(%Procedure)
#CLOSE(%TXAFile)
#OPEN(%TXAFile),READ
#LOOP
#READ(%TXARecord)
#CASE(%TXARecord)
#OF('[END]')
#IF(ITEMS(%Sections))
#DELETE(%Sections,ITEMS(%Sections))
#ELSE
There are more [END]s than expected !
#CYCLE
#ENDIF
#SET(%InEmbed,%False)
#SET(%InstancesLevel,0)
#FOR(%Sections)
#IF(%Sections = '[EMBED]')
#SET(%InEmbed,%True)
#ENDIF
#IF(%Sections = '[INSTANCES]')
#SET(%InstancesLevel,(%InstancesLevel + 1))
#ENDIF
#ENDFOR
#OF('[PROGRAM]')
#ADD(%Sections,%TXARecord)
#OF('[MODULE]')
#ADD(%Sections,%TXARecord)
#OF('[EMBED]')
#ADD(%Sections,%TXARecord)
#SET(%InEmbed,%True)
#OF('[INSTANCES]')
#ADD(%Sections,%TXARecord)
#SET(%InstancesLevel,(%InstancesLevel + 1))
#OF('[DEFINITION]')
#ADD(%Sections,%TXARecord)
#ELSE
#IF(%InEmbed)
#IF(SUB(%TXARecord,1,7) = 'EMBED %')
#SET(%PosibleEmbed,SUB(%TXARecord,7,LEN(CLIP(%TXARecord)) - 6))
#ADD(%Embeds,%PosibleEmbed)
#MESSAGE(%Embeds,3)
#ENDIF
#IF(SUB(%TXARecord,1,7) = 'WHEN ''?' AND %InstancesLevel = 1)
#SET(%PosibleEmbed1,SUB(%TXARecord,7,LEN(CLIP(%TXARecord)) - 7))
#ADD(%ControlsWithEmbeds,%PosibleEmbed1)
#! #MESSAGE(%Embeds & ' : ' & %ControlsWithEmbeds,3)
#ENDIF
#IF(SUB(%TXARecord,1,6) = 'WHEN ''')
#IF(%InstancesLevel = 2)
#SET(%PosibleEmbed2,(SUB(%TXARecord,7,LEN(CLIP(%TXARecord)) -7)))
#IF(%ControlsWithEmbeds <> '')
#ADD(%ControlsWithEmbeds2,%PosibleEmbed2)
#! #MESSAGE(%Embeds & ' : ' & %ControlsWithEmbeds & ' : ' &
%ControlsWithEmbeds2,3)
#ENDIF
#ENDIF
#IF(%InstancesLevel = 3)
#SET(%PosibleEmbed3,(SUB(%TXARecord,7,LEN(CLIP(%TXARecord)) - 7)))
#IF(%ControlsWithEmbeds2 <> '')
#ADD(%ControlsWithEmbeds3,%PosibleEmbed3)
#! #MESSAGE(%Embeds & ' : ' & %ControlsWithEmbeds & ' : ' & %ControlsWithEmbeds2
& ' : ' & %ControlsWithEmbeds3,3)
#ENDIF
#ENDIF
#ENDIF
#ENDIF
#ENDCASE
#IF(%TXARecord = %EOF)
#BREAK
#ENDIF
#ENDLOOP
#!
#IF(ITEMS(%Sections))
There are less [END]s than expected !
#ENDIF
#CLOSE(%TXAFile),READ
#REMOVE(%TXAFile)
#!
#MESSAGE('Embeds were found',3)
#SET(%ProcNamePrinted,%False)
#SET(%EmbedNamePrinted,%False)
#FOR(%Embeds)
#FOR(%ControlsWithEmbeds)
#FIX(%Control,%ControlsWithEmbeds)
#IF(NOT %Control)
#IF(NOT %ProcNamePrinted)
#SET(%ProcNamePrinted,%True)
#SET(%FoundOrphans,%True)
Found with orphaned embeds: %Procedure
--------------------------
#ENDIF
#IF(NOT %EmbedNamePrinted)
#SET(%EmbedNamePrinted,%True)
Source entry point : %Embeds
#ENDIF
Control missing : %ControlsWithEmbeds
#FOR(%ControlsWithEmbeds2),WHERE(%ControlsWithEmbeds)
First Instance : %ControlsWithEmbeds2
#FOR(%ControlsWithEmbeds3),WHERE(%ControlsWithEmbeds2)
Other Instance: %ControlsWithEmbeds3
#ENDFOR
#ENDFOR
#ENDIF
#ENDFOR
#FREE(%ControlsWithEmbeds)
#ENDFOR
#FREE(%Embeds)
#FREE(%Sections)
#ENDFOR
#!
#IF(NOT %FoundOrphans)
No orphaned embeds found in source.
#ELSE
#ERROR('Found Orphaned Embed''s.')
#ENDIF
#CLOSE(%OutputFile)
#!--------------------------------------------------------------------
#! #GROUP(%FindOrphanedEnd)
#!--------------------------------------------------------------------
--
Peter Gysegem
Beaver Creek Software
Printed May 5, 2024, 4:12 am
This article has been viewed/printed 35114 times.
Google search
has resulted in 22 hits on this article since January 25, 2004.
|