Hello this is the updated version of the LibraryLister with a bug removed from its idle handler. The problem was that
a date wasn’t coerced properly when the script was run as an applet. This is fixed by a correct coercion.
The script has now moved from the first post to here.
-- 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/viewtopic.php?id=33712
(*
TERMS OF USE.
This applies only to posting code, as long as you don't post it on other websites, or displays it (the code) on your own, 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.
I don't require you to keep this whole novel, but you must keep the link which refers to where it was originally posted. And my copyright.
You must also state what you eventually have done with the original source. This obviously doesn't matter if you distribute AppleScript as read only. I do not require you to embed any properties helding copyright notice for the code when you distribute as read only.
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.
*)
-- © McUsr 2010 and put in Public Domain see: macscripter.net/viewtopic.php?id=33712 for reference and terms of use.
property bufferList : {} -- will contain filename and buffer and timestamp
property fileList : {}
property bufIndex : 0
property McUsr : "© 2010 and put in public domain - Script Library Lister and put in Public Domain"
property testing : 0
on run
end run
on displayBuffers()
-- Displays the buffers currently held in the server. This functionality is implemented as a "Fall back" pattern.
-- i.e this function is called when you hit escape upon listing the current file. if you then it escape you will be taken to the file choose dialog.
-- you can just press cmd period at any time to abort the script. whatever stage the script is in.
-- returns false or a position to jump to and the file name.
local fileCount, displayList, listIdx, listToShow, defaultPos, theItem, theRecordNumber
set displayList to {}
set fileCount to (count my fileList)
if fileCount is 0 then return false
repeat with i from 1 to fileCount
copy item 1 of item i of my fileList to end of displayList
end repeat
set listIdx to getBuffer(displayList)
if listIdx is false then return false
set item 3 of (item (listIdx) of my fileList) to (current date)
set listToShow to (item 3 of item (listIdx) of my bufferList) -- preplist
set defaultPos to item 4 of item (listIdx) of my bufferList
try
tell me
activate
try
set theItem to choose from list listToShow default items (item defaultPos of listToShow) with prompt (quoted form of POSIX path of (item listIdx of displayList))
end try
end tell
if theItem is not false then
set theRecordNumber to (text 1 thru 2 of (theItem as text)) as number
set defaultPos to theRecordNumber as integer
set item 4 of item (listIdx) of my bufferList to defaultPos
return {matchPos of item theRecordNumber of item 2 of item (listIdx) of my bufferList, item listIdx of displayList}
else
return false
end if
on error e number n
if true is false then
tell me
activate
display dialog "LL: displayBuffers Error : " & e & " : " & n
end tell
end if
return false
end try
end displayBuffers
on getBuffer(hfsTextList)
-- should return index number or false.
local tids, theNames, theDisks, chosenBuffer, idx
script o
property LF : (run script "\"\\n\"") as Unicode text -- Nigel Garvey
end script
set {tids, text item delimiters} to {text item delimiters, o's LF}
set {theNames, text item delimiters} to {every item of hfsTextList as Unicode text, ""}
set {theNames, theDisks} to {every text item of theNames, list disks}
repeat with aDisk in theDisks
set {theNames, text item delimiters} to {theNames as Unicode text, aDisk}
set {theNames, text item delimiters} to {text items of theNames, ""}
end repeat
set {theNames, text item delimiters} to {theNames as Unicode text, ":"}
set {theNames, text item delimiters} to {text items of theNames, "/"}
set theNames to text items of theNames as Unicode text
set {theNames, text item delimiters} to {theNames as Unicode text, o's LF}
set {theNames, text item delimiters} to {text items of theNames, tids}
tell me
activate
set chosenBuffer to (choose from list theNames default items item 1 of theNames with prompt "Choose the library you want to list:")
end tell
if chosenBuffer is false then return false
set idx to indexOfItem(chosenBuffer, theNames)
return idx
end getBuffer
on getPosForEntity(fileAlias)
-- This is the message for the server to show up with a list dialog and
-- whence the libray is not loaded from before. - the files are organized on file names.
try
set listToShow to retrieveSourceText(fileAlias)
set defaultPos to item 4 of item (my bufIndex) of my bufferList
tell me
activate
try
set theItem to choose from list listToShow default items (item defaultPos of listToShow) with prompt (quoted form of POSIX path of (fileAlias))
end try
end tell
if theItem is not false then
set theRecordNumber to (text 1 thru 2 of (theItem as text)) as number
set defaultPos to theRecordNumber as integer
set item 4 of item (my bufIndex) of my bufferList to defaultPos
return matchPos of item theRecordNumber of item 2 of item (my bufIndex) of my bufferList
else
return false
end if
on error e number n
if true is false then
tell me
activate
display dialog "LL: getPosForEntity Error : " & e & " : " & n
end tell
end if
return false
end try
end getPosForEntity
on retrieveSourceText(fileAlias)
-- Gives the list of choices back, and retrieves source and updates any "dirty buffers"
local txtOfLibraryScript, theList, prepList
try
if not my bufferList is {} then
set bufIndex to indexOfItem(fileAlias as text, my fileList)
if bufIndex is 0 then -- make a newe buffer
set txtOfLibraryScript to getLibraryText(fileAlias)
set theList to LLister(txtOfLibraryScript, fileAlias as text)
set prepList to preparateSimpleList(theList)
tell application "Finder" to set fileModDate to (modification date of fileAlias)
set end of my fileList to {fileAlias as Unicode text, fileModDate, (current date)}
set end of my bufferList to {txtOfLibraryScript, theList, prepList, 1}
set bufIndex to (count fileList)
return prepList
else
set bufIndex to bufIndex mod 3 + bufIndex div 3
tell application "Finder" to set fileModDate to (modification date of fileAlias)
if fileModDate is greater than contents of item 2 of (item (bufIndex) of fileList) then -- update contents.
-- I would have gotten the previous handler here.
set txtOfLibraryScript to getLibraryText(fileAlias) -- rereads in the changed file
set theList to LLister(txtOfLibraryScript, fileAlias as text)
set prepList to preparateSimpleList(theList)
set item (bufIndex) of my fileList to {fileAlias as Unicode text, fileModDate, (current date)}
set prevChoice to item 4 of item (bufIndex) of my bufferList
-- checks for if the previous position exists, should really have been the same handler but
-- not now - later!
set bufCount to (count bufferList)
if prevChoice is less than bufCount then
set item (bufIndex) of my bufferList to {txtOfLibraryScript, theList, prepList, prevChoice}
else
set item (bufIndex) of my bufferList to {txtOfLibraryScript, theList, prepList, bufCount}
end if
return prepList
else -- just update expiry date.
set item 3 of (item (bufIndex) of my fileList) to (current date)
return (item 3 of item (bufIndex) of my bufferList) -- preplist
end if
end if
else -- make new buffer.
set txtOfLibraryScript to getLibraryText(fileAlias)
set theList to LLister(txtOfLibraryScript, fileAlias as text)
set prepList to preparateSimpleList(theList)
tell application "Finder"
set fileModDate to modification date of file fileAlias
end tell
set end of my fileList to {fileAlias as Unicode text, fileModDate, (current date)}
set end of my bufferList to {txtOfLibraryScript, theList, prepList, 1}
set bufIndex to 1
return prepList
end if
on error e number n
if false is true then
tell me
activate
display alert "retrieveSourceText :" & e & " : " & n
end tell
end if
error number -128
end try
end retrieveSourceText
on idle
-- empties buffers on two hours expiry
local hadExpired, fileListCount
set fileListCount to (count my fileList)
set hadExpired to false
try
repeat with i from 1 to fileListCount
if (current date) - (contents of item 3 of item i of my fileList as date) is greater than 7200 then -- 2 hours
set {item i of my fileList, item i of my bufferList} to {missing value, missing value}
set hadExpired to true
end if
end repeat
if hadExpired is true then
set my fileList to my fileList's lists
set my bufferList to my bufferList's text
end if
on error e number n
tell me
activate
display alert "LL's Idle handler : error " & e & " : " & n
end tell
end try
if hadExpired is false and fileListCount is 0 then
tell me to quit
end if
return 900 -- 15 minutes
end idle
on indexOfItem(theItem, itemsList) -- credit to Emmanuel Levy but I modified it with the considering case statements
local rs
considering case
set text item delimiters to return
set itemsList to return & itemsList & return
set text item delimiters to {""}
try
set rs to -1 + (count (paragraphs of (text 1 thru (offset of (return & theItem & return) in itemsList) of itemsList)))
on error
return 0
end try
rs
end considering
end indexOfItem
on LLister(txtOfLibraryScript, hfSfileNameAsText)
script o
property McUsr : "11 Modified for server usage: From LibraryLister 7.0 Non optimized, which works best in the most cases"
property MAXLEVEL : 4
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, ""}
getBlockCommentPositions(txtOfLibraryScript, commentlist)
-- Collects level 1 script objects.
(* set AppleScript's text item delimiters to ","
log "commentlist " & commentlist
set AppleScript's text item delimiters to ""
return
*)
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 " & hfSfileNameAsText & "!"
error number -128
end tell
end if
set {tabString, level2Handlers} to {"\t", {}} -- 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, scriptObjectEntities, washingCandidates, callCount, o's 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)}
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 MergedList to item ScriptObjectItemNo of scriptObjectEntities
set ScriptObjectItemNo to ScriptObjectItemNo + 1
else if (matchPos of contents of item HandlerItemNo of level1Handlers < matchPos of contents of item ScriptObjectItemNo of scriptObjectEntities) then
set end of MergedList to item HandlerItemNo of level1Handlers
set HandlerItemNo to HandlerItemNo + 1
else
set end of MergedList to item ScriptObjectItemNo of 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, o's 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
return MergedList -- this is a very bad idea maybe. maybe not.
-- extracts the result for viewing
end LLister
on preparateSimpleList(theList)
script o
property l : theList
property m : {}
end script
local displayList
set displayList to {}
repeat with i from 1 to (count theList)
set end of o's m to (text -2 thru -1 of ("00" & i)) & " " & matchResult of item i of o's l
end repeat
return o's m
end preparateSimpleList
on getLibraryText(fileAlias) -- Thanks to oldmanegan
-- reworked since 7.0 since will use. returns text of Script library upon success
-- factored out for the case that we will maintain buffers.
local theSourceText, qfPoxPath
set qfPoxPath to quoted form of POSIX path of (fileAlias)
try
fileAlias as alias
on error e number n
set bad to true
end try
try
set theSourceText to do shell script "/usr/bin/osadecompile " & qfPoxPath & "| /usr/bin/tr -d '\\000'"
on error e number n
tell me
activate
display alert "getLibraryText" & e & " : " & n
end tell
error number -128
end try
if theSourceText is "" then
tell me
activate
display alert "getLibraryText: The Script " & qfPoxPath & " is empty, or left in debugging state"
end tell
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 & "\t"), {}}
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, MergedList, 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 & "\t"
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, MergedList, washingCandidates, callCount, MAXLEVEL)
-- returns a list with merged handlers also tags any script objects empty so far.
local HandlerFirstPos, HandlerItemNo, HandlerCount, ScriptObjectFirstPos, ScriptObjectItemNo, ScriptObjectCount, lastWasScriptObject
if HandlerList is not {} then
set {HandlerFirstPos, HandlerItemNo, HandlerCount} to {matchPos of item 1 of HandlerList, 1, (count HandlerList)}
set {ScriptObjectFirstPos, ScriptObjectItemNo, ScriptObjectCount} to {matchPos of item 1 of ScriptObjectList, 2, (count ScriptObjectList)}
set {MergedList, end of MergedList, lastWasScriptObject} to {{}, item 1 of ScriptObjectList, 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 MergedList to item HandlerItemNo of HandlerList
set HandlerItemNo to HandlerItemNo + 1
else if HandlerItemNo > HandlerCount then
if lastWasScriptObject is true then
set end of washingCandidates to {ScriptObjectItemNo, item -1 of MergedList}
set lastWasScriptObject to false
else
set end of MergedList to item ScriptObjectItemNo of ScriptObjectList
set end of washingCandidates to {(ScriptObjectItemNo + 1), item ScriptObjectItemNo of ScriptObjectList}
set ScriptObjectItemNo to ScriptObjectItemNo + 1
end if
else if (matchPos of contents of item HandlerItemNo of HandlerList < matchPos of contents of item ScriptObjectItemNo of ScriptObjectList) then
set lastWasScriptObject to false
set end of MergedList to item HandlerItemNo of HandlerList
set HandlerItemNo to HandlerItemNo + 1
else -- Script object has a lower position value
if lastWasScriptObject is false then
set end of MergedList to item ScriptObjectItemNo of ScriptObjectList
else -- two script objects in a row
set end of washingCandidates to {ScriptObjectItemNo, item -1 of MergedList}
set end of MergedList to item ScriptObjectItemNo of ScriptObjectList
end if
set ScriptObjectItemNo to ScriptObjectItemNo + 1
set lastWasScriptObject to true
end if
end repeat
if lastWasScriptObject is true then set end of washingCandidates to {ScriptObjectItemNo, item -1 of MergedList}
set HandlerList to missing value
else
set MergedList to ScriptObjectList
end if
return MergedList
end mergeHandlersFindPossibleEmptyScriptObjects
on mergeCleanLists(parentList, childList)
-- 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 parentList}
-- 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 childList
set childItemNo to childItemNo + 1
else if (childItemNo > childCount) then
set end of resultList to item parentItemNo of parentList
set parentItemNo to parentItemNo + 1
else if (matchPos of contents of item childItemNo of childList < matchPos of contents of item parentItemNo of parentList) then
set end of resultList to item childItemNo of childList
set childItemNo to childItemNo + 1
else
set end of resultList to item parentItemNo of parentList
set parentItemNo to parentItemNo + 1
end if
end repeat
return resultList
else
return parentList
end if
end mergeCleanLists
on washParentListForEmptyObjects(parentList, childList, origScrObjList, washList)
-- 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 washList
set washLastPos to matchPos of item (item 1 of item washItemNo of washList) of origScrObjList
repeat while washItemNo ≤ washCount
set foundLaterChild to false
repeat with i from childItemNo to childCount
set curChildPos to matchPos of item i of childList
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 parentList = washFirstPos then
set item j of parentList 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 contents of parentCount
if matchPos of item j of parentList = washFirstPos then
set item j of parentList 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 washList
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 washList
set washLastPos to matchPos of item (item 1 of item washItemNo of washList) of origScrObjList
end if
end repeat
set parentList to parentList's records
-- else -just return the parentList
end if
return parentList
end washParentListForEmptyObjects
on washMergeListForEmptyScriptObjects(mergeList, washList)
-- 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 washList
repeat with j from mergeItemNo to mergeCount
if matchPos of item j of mergeList = washFirstPos then
set item j of mergeList 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 mergeList'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 doneProcessing, frompos, openingPattern, closingPattern, openingPos, notFound, nextOpeningPos, closingPos
set {frompos, openingPattern, closingPattern} to {0, "([(][*])", "([*][)])"}
repeat
try
set openingPos to matchPos of (find text openingPattern in o's l using "\\0" starting at frompos with regexp)
-- opening tag
set frompos to openingPos + 3
repeat
set notFound to false
try
set nextOpeningPos to matchPos of (find text openingPattern in o's l using "\\0" starting at frompos with regexp)
on error
set notFound to true
end try
try
set closingPos to matchPos of (find text closingPattern in o's l using "\\0" starting at frompos with regexp)
on error e number n
tell me
activate
display alert "Error finding closing comment, malformed or emebedded start comment between hyphens."
error number -128
end tell
end try
if notFound is true then
exit repeat
else if nextOpeningPos < closingPos then
set frompos to closingPos + 3
else
exit repeat
end if
end repeat
-- copy {openingPos, closingPos} to end of o's m
set end of o's m to {openingPos, closingPos}
on error e number n
if n is -128 then
error number -128 -- cascade
else
exit repeat
end if
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
