|
Add a comment to an Icetips Article
Please add your comments to this article.
Please note that you must provide both a name and a valid email address in order
for us to publish your comment. Comments are moderated and are not visible until they have been approved. Spam is never approved!
Back to article list
Search Articles
Add Comment
Printer friendly
Direct link
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
Today is November 21, 2024, 7:13 am This article has been viewed 35312 times.
Google search
has resulted in 22 hits on this article since January 25, 2004.
Back to article list
Search Articles
Add Comment
Printer friendly
|
|
|