` Finding orphaned embed points (Peter Gysegem) - 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  

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, 3:59 am
This article has been viewed 35311 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

Login

User Name:

Password:


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