Optimized version as described in post above
-- A library lister that returns a hierarchic view of script objects and handlers in an as Library file.
-- a nice feature would be to exclude an opened file from the recent items menu.
-- The Idea and implementation and any faults is totally mine. © McUsr 2010 and put in the Public Domain.
-- The usually guarrantees about nothing what so ever applies, use it at your own risk.
-- Read the documentation.
-- You are not allowed to post this code elsewhere, but may of course refer to the post at macscripter.net.
-- macscripter.net/post.php?tid=131179
(*
TERMS OF USE.
This applies only to posting code, as long as you don't post it, you are welcome to do
whatever you want to do with it without any further permission.
Except for the following: Selling the code as is, or removing copyright statmentents and the embedded link in the code (without the http:// part) from the code.
You must also state what you eventually have done with the original source. This obviously doesn't matter if you distribure AppleScript as read only. I do not require you to embed any properties helding copyright notice for the code.
Credit for having contributed to your product would in all cases be nice!
If you use this code as part of script of yours you are of course welcome to post that code with my code in it here at macscripter.net. If you then wish to post your code elsewhere after having uploaded it to MacScripter.net please email me and ask for permission.
The ideal situation is however that you then refer to your code by a link to MacScripter.net
The sole reason for this, is that it is so much better for all of us to have a centralized codebase which are updated, than having to roam the net to find any usable snippets. Which some of us probabaly originated in the first hand.
I'm picky about this. If I find you to have published parts of my code on any other site without previous permission, I'll do what I can to have the site remove the code, ban you, and sue you under the jurisdiction of AGDER LAGMANNSRETT of Norway. Those are the terms you silently agree too by using this code.
The above paragraphs are also valid if you violate any of my terms.
If you use this or have advantage of this code in a professional setting, where professional setting means that you use this code to earn money by keeping yourself more productive. Or if you as an employee share the resulting script with other coworkers, enhancing the productivity of your company, then a modest donation to MacScripter.net would be appreciated.
*)
property McUsr : "1.1 Basic Optimization"
-- property timer : (load script file "Macintosh HD:Users:McUsr:Library:Scripts:Modules:timerTools.scpt")
-- property parent : timer -- DONT use this if script is included as a whole. For timer purposes
” property res : 0
property MAXLEVEL : 4
on run
script o
property pxLibPath : ""
property level1Handlers : {}
property MergedList : {}
property scriptObjectEntities : {}
end script
local txtOfLibraryScript
local commentlist, level1ScriptObjects, level1Handlers, level2Handlers, scriptObjectEntities, washingCandidates, MergedList, childList
local callCount, startPattern, tabString
set {commentlist, level1ScriptObjects, level1Handlers, level2Handlers, scriptObjectEntities, washingCandidates, MergedList} to {{}, {}, {}, {}, {}, {}, {}}
set {callCount, tabString} to {0, ""}
set txtOfLibraryScript to getLibraryText(a reference to o's pxLibPath)
-- ************
-- tell timer to run
-- set t to getMillisec()
-- ***********
getBlockCommentPositions(txtOfLibraryScript, commentlist)
-- Collects level 1 script objects.
set level1ScriptObjects to makeEntityList(("^" & tabString & "(script|using terms from)[ ](.*$)"), "\\2", txtOfLibraryScript)
set level1ScriptObjects to washOutBlockCommentedEntities(level1ScriptObjects, commentlist)
-- collects level 1 handlers.
set level1Handlers to makeEntityList(("^" & tabString & "(on|to)[ ](.*$)"), "\\2", txtOfLibraryScript)
set level1Handlers to washOutBlockCommentedEntities(level1Handlers, commentlist)
set level1Handlers to washOutOnErrorStatements(level1Handlers)
if level1ScriptObjects is {} and level1Handlers is {} then
tell me
activate
display alert "There were no script objects nor handlers in in " & o's pxLibPath & "!"
error number -128
end tell
end if
set {tabString, level2Handlers} to {" ", {}} -- uses the new value for retrieving any level 2 script objects as well.
if level1ScriptObjects is not {} then
-- collect any level 2 handlers.
set level2Handlers to makeEntityList(("^" & tabString & "(on|to)[ ](.*$)"), "\\2", txtOfLibraryScript)
set level2Handlers to washOutBlockCommentedEntities(level2Handlers, commentlist)
set level2Handlers to washOutOnErrorStatements(level2Handlers)
set level2Handlers to prependIndent(tabString, level2Handlers)
-- Merge the Level2 handlers with the ScriptObjects List and create a Candidates list for washing at the same time.
set scriptObjectEntities to mergeHandlersFindPossibleEmptyScriptObjects(level2Handlers, level1ScriptObjects, washingCandidates, callCount, MAXLEVEL)
set level2Handlers to missing value
end if
if level1Handlers is not {} and scriptObjectEntities is not {} then
-- Merges level1Handlers with scriptObjectEntites before adding any children.
local HandlerFirstPos, HandlerItemNo, HandlerCount, ScriptObjectFirstPos, ScriptObjectItemNo, ScriptObjectCount
set {HandlerFirstPos, HandlerItemNo, HandlerCount} to {matchPos of item 1 of level1Handlers, 1, (count level1Handlers)}
set {ScriptObjectFirstPos, ScriptObjectItemNo, ScriptObjectCount} to {matchPos of item 1 of scriptObjectEntities, 1, (count scriptObjectEntities)}
set {o's MergedList, o's scriptObjectEntities, o's level1Handlers} to {MergedList, scriptObjectEntities, level1Handlers}
repeat while ((ScriptObjectItemNo ≤ ScriptObjectCount) or (HandlerItemNo ≤ HandlerCount))
if (ScriptObjectItemNo > ScriptObjectCount) then
set end of MergedList to item HandlerItemNo of level1Handlers
set HandlerItemNo to HandlerItemNo + 1
else if (HandlerItemNo > HandlerCount) then
set end of o's MergedList to item ScriptObjectItemNo of o's scriptObjectEntities
set ScriptObjectItemNo to ScriptObjectItemNo + 1
else if (matchPos of contents of item HandlerItemNo of o's level1Handlers < matchPos of contents of item ScriptObjectItemNo of o's scriptObjectEntities) then
set end of MergedList to item HandlerItemNo of o's level1Handlers
set HandlerItemNo to HandlerItemNo + 1
else
set end of o's MergedList to item ScriptObjectItemNo of o's scriptObjectEntities
set ScriptObjectItemNo to ScriptObjectItemNo + 1
end if
end repeat
else if level1Handlers is {} then
set MergedList to scriptObjectEntities
else -- had to have handlers, -- we had to to get here.
set MergedList to level1Handlers
end if
-- we are now getting at level 2 script objects, i.e at the same level as the level2 handlers.
set childList to getScriptObjectEntities(tabString, txtOfLibraryScript, commentlist, callCount, MAXLEVEL)
-- following handlers check for an empty child list
if washingCandidates ≠{} then
set MergedList to washParentListForEmptyObjects(MergedList, childList, level1ScriptObjects, washingCandidates)
end if
set {level1ScriptObjects, washingCandidates} to {missing value, missing value}
set MergedList to mergeCleanLists(MergedList, childList)
set childList to missing value
-- ************
-- set res to ((getMillisec()) - t) / 1000
-- ************
-- extracts the result for viewing
set displayList to {}
repeat with anItem in MergedList
set end of displayList to matchResult of anItem
end repeat
tell me
activate
set theItem to choose from list displayList default items (item 1 of displayList) with prompt o's pxLibPath
end tell
set {tids, AppleScript's text item delimiters} to {AppleScript's text item delimiters, return}
set displayList to text items of displayList as text
set AppleScript's text item delimiters to tids
set test to "A ;-)"
end run
on getLibraryText(aRefToPxFile)
-- returns text of Script library upon success
local theSourceText, thisScript, qfPoxPath
set thisScript to (choose file) as text
set contents of aRefToPxFile to POSIX path of thisScript
set qfPoxPath to quoted form of POSIX path of thisScript as text
try
set theSourceText to do shell script "/usr/bin/osadecompile " & qfPoxPath & "| /usr/bin/tr -d '\\000'"
on error e number n
display alert e & " : " & n
error number -128
end try
if theSourceText is "" then
display alert "The Script is empty, or left in debugging state"
error number -128
end if
return theSourceText
end getLibraryText
on getScriptObjectEntities(tabIndent, theTextToPeruse, commentlist, callCount, MAXLEVEL)
-- Collects a script object with its contents. returns a single indented list of items.
-- Emtpy script objects washed away.
-- CONTEXT: The first level of both handlers and script objects and the second level of handlers is already parsed
local tabCount, originalIndent, ScriptObjectList, HandlerList
set {tabCount, originalIndent, ScriptObjectList, callCount} to {1, tabIndent, {}, callCount + 1}
-- Collects script objects.
set ScriptObjectList to makeEntityList(("^" & tabIndent & "(script|using terms from)[ ](.*$)"), "\\2", theTextToPeruse)
set ScriptObjectList to washOutBlockCommentedEntities(ScriptObjectList, commentlist)
set ScriptObjectList to prependIndent(tabIndent, ScriptObjectList)
if ScriptObjectList is not {} then -- END CONDITON FOR RECURSION
-- Finds any handlers in the script objects so far.
set {tabIndent, HandlerList} to {(tabIndent & " "), {}}
set HandlerList to makeEntityList(("^" & tabIndent & "(on|to)[ ](.*$)"), "\\2", theTextToPeruse)
set HandlerList to washOutBlockCommentedEntities(HandlerList, commentlist)
set HandlerList to washOutOnErrorStatements(HandlerList)
set HandlerList to prependIndent(tabIndent, HandlerList)
if HandlerList is {} and callCount is MAXLEVEL then return {}
else
return {}
end if
-- Merges the eventual outcome of previous gathering into single lists, marks possible empty script objects for washing.
local MergedList, washingCandidates
set {MergedList, washingCandidates} to {{}, {}}
set MergedList to mergeHandlersFindPossibleEmptyScriptObjects(HandlerList, ScriptObjectList, washingCandidates, callCount, MAXLEVEL)
if HandlerList is {} then
set washingCandidates to indexByNextAList(ScriptObjectList)
end if
set HandlerList to missing value
if callCount is MAXLEVEL then
-- washes out any candidates from findings in mergeHandlersFindPossibleEmptyScriptObjects
set MergedList to washMergeListForEmptyScriptObjects(MergedList, washingCandidates)
return MergedList
else
-- Washes away empty script objects with our aquired facts.
set tabIndent to originalIndent & " "
set childList to getScriptObjectEntities(tabIndent, theTextToPeruse, commentlist, callCount, MAXLEVEL)
if childList is not {} then
-- following handlers check for an empty child list
set MergedList to washParentListForEmptyObjects(MergedList, childList, ScriptObjectList, washingCandidates)
else
-- just removes any items of the washlist one bye one.
set MergedList to washMergeListForEmptyScriptObjects(MergedList, washingCandidates)
end if
set {ScriptObjectList, washingCandidates} to {missing value, missing value}
set MergedList to mergeCleanLists(MergedList, childList)
set childList to missing value
return MergedList
end if
end getScriptObjectEntities
on mergeHandlersFindPossibleEmptyScriptObjects(HandlerList, ScriptObjectList, washingCandidates, callCount, MAXLEVEL)
-- returns a list with merged handlers also tags any script objects empty so far.
script o
property hndlList : HandlerList
property scobjList : ScriptObjectList
property mrgdList : {}
property washList : washingCandidates
end script
local HandlerFirstPos, HandlerItemNo, HandlerCount, ScriptObjectFirstPos, ScriptObjectItemNo, ScriptObjectCount, lastWasScriptObject
if HandlerList is not {} then
set {HandlerFirstPos, HandlerItemNo, HandlerCount} to {matchPos of item 1 of o's hndlList, 1, (count HandlerList)}
set {ScriptObjectFirstPos, ScriptObjectItemNo, ScriptObjectCount} to {matchPos of item 1 of o's scobjList, 2, (count ScriptObjectList)}
set {end of o's mrgdList, lastWasScriptObject} to {item 1 of o's scobjList, true}
repeat while ((ScriptObjectItemNo ≤ ScriptObjectCount) or (HandlerItemNo ≤ HandlerCount))
if (ScriptObjectItemNo > ScriptObjectCount) then
set lastWasScriptObject to false -- because: there isn't any other script object to add at this moment.
set end of o's mrgdList to item HandlerItemNo of o's hndlList
set HandlerItemNo to HandlerItemNo + 1
else if HandlerItemNo > HandlerCount then
if lastWasScriptObject is true then
set end of o's washList to {ScriptObjectItemNo, item -1 of o's mrgdList}
set lastWasScriptObject to false
else
set end of o's mrgdList to item ScriptObjectItemNo of o's scobjList
set end of o's washList to {(ScriptObjectItemNo + 1), item ScriptObjectItemNo of o's scobjList}
set ScriptObjectItemNo to ScriptObjectItemNo + 1
end if
else if (matchPos of contents of item HandlerItemNo of o's hndlList < matchPos of contents of item ScriptObjectItemNo of o's scobjList) then
set lastWasScriptObject to false
set end of o's mrgdList to item HandlerItemNo of o's hndlList
set HandlerItemNo to HandlerItemNo + 1
else -- Script object has a lower position value
if lastWasScriptObject is false then
set end of o's mrgdList to item ScriptObjectItemNo of o's scobjList
else -- two script objects in a row
set end of o's washList to {ScriptObjectItemNo, item -1 of o's mrgdList}
set end of o's mrgdList to item ScriptObjectItemNo of o's scobjList
end if
set ScriptObjectItemNo to ScriptObjectItemNo + 1
set lastWasScriptObject to true
end if
end repeat
if lastWasScriptObject is true then set end of o's washList to {ScriptObjectItemNo, item -1 of o's mrgdList}
set o's hndlList to missing value
else
set o's mrgdList to o's scobjList
end if
return o's mrgdList
end mergeHandlersFindPossibleEmptyScriptObjects
on mergeCleanLists(parentList, childList)
script o
property parentL : parentList
property childL : childList
end script
-- Merges two lists, by order of matchpos, returns result
-- the ParentList is higher up in the hierarchy, therefore contains preceding elements.
if not childList is {} then -- superfluos but
local resultList, parentItemNo, parentCount, childItemNo, childCount
set {parentItemNo, parentCount, childItemNo, childCount} to {2, (count parentList), 1, (count childList)}
set {resultList, end of resultList} to {{}, item 1 of o's parentL}
-- Safely assume that first item in merg list has lower pos than first in child list
repeat while ((parentItemNo ≤ parentCount) or (childItemNo ≤ childCount))
if (parentItemNo > parentCount) then
set end of resultList to item childItemNo of o's childL
set childItemNo to childItemNo + 1
else if (childItemNo > childCount) then
set end of resultList to item parentItemNo of o's parentL
set parentItemNo to parentItemNo + 1
else if (matchPos of contents of item childItemNo of o's childL < matchPos of contents of item parentItemNo of o's parentL) then
set end of resultList to item childItemNo of o's childL
set childItemNo to childItemNo + 1
else
set end of resultList to item parentItemNo of o's parentL
set parentItemNo to parentItemNo + 1
end if
end repeat
return resultList
else
return parentList
end if
end mergeCleanLists
on washParentListForEmptyObjects(parentList, childList, origScrObjList, washList)
script o
property parentL : parentList
property childL : childList
property origL : origScrObjList
property washL : washList
end script
-- compares elements in parent list with child list and washlist.
-- draws a conclusion wether parent element is really empty, then removes it.
local parentItemNo, parentCount, childItemNo, washItemNo, washCount, washFirstPos, washLastPos, foundLaterChild, curChildPos
set {parentItemNo, parentCount, childItemNo, childCount, washItemNo, washCount} to {1, (count parentList), 1, (count childList), 1, (count washList)}
if washList ≠{} and childList ≠{} then
set washFirstPos to matchPos of item 2 of item washItemNo of o's washL
set washLastPos to matchPos of item (item 1 of item washItemNo of o's washL) of o's origL
repeat while washItemNo ≤ washCount
set foundLaterChild to false
repeat with i from childItemNo to childCount
set curChildPos to matchPos of item i of o's childL
if curChildPos > washFirstPos and curChildPos < washLastPos then
set washItemNo to washItemNo + 1
set childItemNo to childItemNo + 1
set foundLaterChild to true
exit repeat -- found sibling keeps this candidate
else if curChildPos > washLastPos then -- must be less than, positions are unique
set foundLaterChild to true -- we bypassed the candidate
repeat with j from parentItemNo to parentCount
if matchPos of item j of o's parentL = washFirstPos then
set item j of o's parentL to missing value
set mergeItemNo to j + 1
exit repeat
end if
end repeat
set washItemNo to washItemNo + 1
set foundLaterChild to true
exit repeat
end if
end repeat
if foundLaterChild is false then
-- all there is to delete every member of washingList from parentList
repeat with i from washItemNo to washCount
repeat with j from parentItemNo to parentCount
if matchPos of item j of o's parentL = washFirstPos then
set item j of o's parentL to missing value
set parentItemNo to j + 1
exit repeat
end if
-- set washFirstPos to matchPos of item 2 of item (i + 1) of washList
if i < washCount then
set washFirstPos to matchPos of item 2 of item (i + 1) of o's washL
else
exit repeat
end if
end repeat
end repeat
exit repeat -- done WASHING
else
set washFirstPos to matchPos of item 2 of item washItemNo of o's washL
set washLastPos to matchPos of item (item 1 of item washItemNo of washList) of o's origL
end if
end repeat
set parentList to o's parentL's records
-- else -just return the parentList
end if
return parentList
end washParentListForEmptyObjects
on washMergeListForEmptyScriptObjects(mergeList, washList)
script o
property mergeL : mergeList
property washL : washList
end script
-- cleans a list for empty script objects,when there were no new children.
local mergeItemNo, washItemNo, washCount, washFirstPos
set {mergeItemNo, mergeCount, washItemNo, washCount} to {1, (count mergeList), 1, (count washList)}
if washList ≠{} then
repeat with i from washItemNo to washCount
set washFirstPos to matchPos of item 2 of item i of o's washL
repeat with j from mergeItemNo to mergeCount
if matchPos of item j of o's mergeL = washFirstPos then
set item j of o's mergeL to missing value
set mergeItemNo to j + 1
exit repeat
end if
end repeat
end repeat
-- else -- nothing to merge nor wash
set mergeList to o's mergeL's records
else
return mergeList
end if
end washMergeListForEmptyScriptObjects
on washOutBlockCommentedEntities(entityList, blockCommentList)
-- removes any entity that is within a block comment.
script o
property l : entityList
end script
if not entityList is {} then
repeat with i from 1 to (count entityList)
if withinABlockComment(matchPos of (contents of item i of o's l), blockCommentList) then
set item i of o's l to missing value
end if
end repeat
set entityList to o's l's records
end if
return entityList
end washOutBlockCommentedEntities
on washOutOnErrorStatements(HandlerList)
-- removes the "on error" statements.
script o
property l : HandlerList
end script
if not HandlerList is {} then
repeat with i from 1 to (count HandlerList)
if matchResult of (contents of item i of o's l) is "error" or matchResult of (contents of item i of o's l) starts with "error " then
set item i of o's l to missing value
end if
end repeat
set HandlerList to o's l's records
end if
return HandlerList
end washOutOnErrorStatements
on makeEntityList(seachString, searchItemNr, theTextToPeruse)
-- Harvests out a list of entities of type specified by parameters.
script o
property l : theTextToPeruse
end script
local theRes
set theRes to find text seachString in o's l using searchItemNr starting at 0 with regexp and all occurrences
return theRes
end makeEntityList
on prependIndent(tabIndent, HandlerList)
-- idents the element after we have washed out error statments for handlers
-- anytime for script objects
script o
property l : HandlerList
end script
repeat with i from 1 to (count HandlerList)
set matchResult of (item i of o's l) to tabIndent & (matchResult of (contents of item i of o's l))
end repeat
return o's l
end prependIndent
-- tells us if a pos of a particular handler is witihin a block comment.
on withinABlockComment(aPos, listOfBlockPos)
script o
property l : listOfBlockPos
end script
repeat with i from 1 to (count listOfBlockPos)
if item 1 of item i of o's l < aPos and item 2 of item i of o's l > aPos then return true
end repeat
return false
end withinABlockComment
on getBlockCommentPositions(theTextToPeruse, listOfBlockPos)
-- creates a list with start and end positons of block comments
script o
property l : theTextToPeruse
property m : listOfBlockPos
end script
local startPattern, SearchPattern, frompos, theRes, PrevPos
set startPattern to true
set SearchPattern to "^([(][*])"
set frompos to 0
repeat
try
set theRes to find text SearchPattern in o's l using "\\0" starting at frompos with regexp
set startPattern to not startPattern
if startPattern then
-- it was the end pattern we just found
set SearchPattern to "^([(][*])"
-- saving our results
try
copy {PrevPos, matchPos of theRes} to end of o's m
on error e number n
display alert e & " : " & n
end try
else
copy matchPos of theRes to PrevPos
-- it was the start pattern we just found
set SearchPattern to "^([*][)])"
end if
set frompos to ((matchPos of theRes) + (matchLen of theRes) + 1)
on error
-- we better having erred on the first RegExp.
if not startPattern then
error "malformed comments - can't happen"
end if
exit repeat
end try
end repeat
return listOfBlockPos
end getBlockCommentPositions
on indexByNextAList(listToIndex)
-- returns a list of lists, with item in list preceeded by its index+1.
script o
property l : listToIndex
end script
local newList
set newList to {}
repeat with i from 1 to (count listToIndex)
set end of newList to {(i + 1), item i of o's l}
end repeat
return newList
end indexByNextAList
It was top of the line in jan 2010 what MacBook Pro’s are concerned.