function Clean fs

-- remove leading and trailing returns tabs and spaces

repeat while char 1 of fs is in return&tab&space

delete char 1 of fs

end repeat

repeat while char -1 of fs is in return&tab&space

delete char -1 of fs

end repeat

return fs

end Clean

function Q fs

-- because it is more readable to use "`" in a string literal than to write "&quote&"

replace "`" with quote in fs

return fs

end Q

put Q("<span style='color: red;'>")

function Thousands fn

-- fn: a number passed as a character string

-- return the number with apostrophes marking groups of three digits in the integer part

-- and spaces marking groups of three digits in the decimal part

-- i.e. 1234567.89012345 becomes 1'234'567.890 123 45

-- and 123.456 remains 123.456

local ldoto -- offset of the decimal point

local lint -- length of the integer part

local ldec -- length of the decimal part

local ich -- index into character string fn

local ll -- length of fn

local lnrapostrophes -- number of apostrophes to be inserted

local lnrspaces -- number of spaces to be inserted

-- number n of apostrophes for length lint of integer part:

-- lint 0 1 2 3 4 5 6 7 8 9 10 11 12 ...

-- n 0 0 0 0 1 1 1 2 2 2 3 3 ...

-- n = (lint-1) div 3 if lint >0 and 0 if lint = 0

-- number n of spaces for length ldec of decimal part:

-- ldec 0 1 2 3 4 5 6 7 8 9 10 11 12 ...

-- n 0 0 0 0 1 1 1 2 2 2 3 3 ...

-- --> same formula.

put length(fn) into ll

put offset(".",fn) into ldoto

if ldoto=0 then -- it is an integer

put ll+1-4 into ich

put ll into lint

put 0 into ldec

else

put ldoto-4 into ich

put ldoto-1 into lint

put ll-ldoto into ldec

end if

-- do the apostrophes first:

if lint>0 then put (lint-1) div 3 into lnrapostrophes else put 0 into lnrapostrophes

repeat

if ich<=0 then exit repeat

put "'" after char ich of fn

subtract 3 from ich

end repeat

-- now do the spaces in the decimal part:

if ldec>0 then put (ldec-1) div 3 into lnrspaces else put 0 into lnrspaces

if lnrspaces=0 then return fn -- this is the most common case: the number has less than three decimal places if any.

put lnrapostrophes+ldoto+3 into ich

repeat with i=1 to lnrspaces

put space after char ich of fn

add 4 to ich

end repeat

return fn

end Thousands

function UnThousands fn

-- inverse of Thousands

replace "'" with "" in fn; replace " " with "" in fn

return fn

end UnThousands

function Padded fs,fn

-- pads fs with blanks at the end to make its length equal to fn.

repeat with i=1 to fn-length(fs)

put space after fs

end repeat

return fs

end Padded

function Indent fs,fn

-- puts fn spaces before every line of fs.

put "" into lIndent

repeat with i=1 to fn

put space after lIndent

end repeat

repeat with i=1 to the number of lines of fs

put lIndent before line i of fs

end repeat

return fs

end Indent

on MultiSortFields -- fieldname1, other fieldnames

-- Sort lines of a set of fields according to one field

--

-- the first field will be sorted by line,

-- the others will be rearranged accordingly.

-- Assumption: all fields have the same number of lines

--

-- If some lines are numbers, the comparison for sorting can be numeric or text.

-- Numbers will "float" to the top and be sorted there numerically.

--

put "" into lFields

repeat with i=1 to the paramcount

put "field "&quote&param(i)&quote&"," after lFields

end repeat

delete last char of lCommand

do "put MultipleSorted("&lFields&") into lv"

repeat with i=1 to the paramcount

do "put lv["&i&"] into field "&quote&param(i)&quote

end repeat

end MultiSortFields

function MultipleSorted -- parameters

-- Call: in two stages:

-- put multiplesorted(field "A",field "B", field "C") into lv

-- put lv[1] into field "SA"; put lv[2] into field "SB"; put lv[3] into field "SC"

put the paramcount into nParams

repeat with i=1 to nParams

put "" into ArrayOfSorted[i]

end repeat

-- do a simple insertion sort:

put 0 into iLinesPlaced; put 0 into lCurrentLine

repeat for each line lLineToBeInserted in param(1)

put false into lLinePlaced; add 1 to lCurrentLine

-- go find where in the corresponding sorted result to place it:

put 0 into lCurrentPlacedLine

repeat for each line lLineFromPlaced in ArrayOfSorted[1]

add 1 to lCurrentPlacedLine

if lLineToBeInserted < lLineFromPlaced then -- found a place to put this line

put lLineToBeInserted&return before line lCurrentPlacedLine of ArrayOfSorted[1]

repeat with iOtherText = 2 to nParams -- the lines of the other fields

put (line lCurrentLine of param(iOtherText))&return before line lCurrentPlacedLine of ArrayOfSorted[iOtherText]

end repeat

put true into lLinePlaced

exit repeat

end if

end repeat

if not lLinePlaced then -- put it at the end

put lLineToBeInserted&return after ArrayOfSorted[1]

repeat with iOtherText=2 to nParams

put (line lCurrentLine of param(iOtherText))&return after ArrayOfSorted[iOtherText]

end repeat

end if

add 1 to iLinesPlaced; -- put "{"&ArrayOfSorted[1]&"}"

end repeat

return ArrayOfSorted

end MultipleSorted

function ISODateTime

-- returns the date and time as YYYY-MM-DD HH:MM:SS W

-- where W is the number of the day in the week (1=Monday, 7=Sunday)

-- The dateitems conversion returns a USA weekday number.

-- Convert this to standard weekday number:

-- Day: M T W T F S S Day of the week

-- nr: 2 3 4 5 6 7 1 USA number, what we get from the dateitems

-- real: 1 2 3 4 5 6 7 Standard number, what we want

-- we will need to use modular arithmetic, so consider:

-- real -1: 0 1 2 3 4 5 6 this looks like the result of a mod 7 operation

-- nr+5: 7 8 9 10 11 12 6 and this gives real-1 after a mod 7

-- (nr+5) mod 7 +1: 1 2 3 4 5 6 7 done!

put the long time into t; convert t to dateitems -- this works no matter what the user's preferences are.

-- Dateitems results in YYYY,MM,DD,HH,MM,SS,WD

-- the numbers returned must also be prefixed with "0" if less than 10.

put item 1 of t into lY

put item 2 of t into lM; if lM < 10 then put "0" before lM

put item 3 of t into lD; if lD < 10 then put "0" before lD

put item 4 of t into lHH; if lHH < 10 then put "0" before lHH

put item 5 of t into lMM; if lMM < 10 then put "0" before lMM

put item 6 of t into lSS; if lSS < 10 then put "0" before lSS

put item 7 of t into lW; put (lW +5)mod 7 +1 into lW

return lY&"-"&lM&"-"&lD&" "&lHH&":"&lMM&":"&lSS&" "&lW

end ISODateTime

function ISOtoSeconds ft

-- converts a date-time in format YYYY-MM-DD hh:mm:ss into the number of seconds since midnight 1 January 1970

replace "-" with "," in ft; replace ":" with "," in ft; replace space with "," in ft; put ft&",0" into ft

convert ft to seconds

return ft

end ISOtoSeconds

function SecondsToISO fs

-- converts a number of seconds since midnight of 1 Januray 1970 to a date of format YYYY-MM-DD hh:mm:ss

convert fs to dateitems

repeat with i=2 to 6

if item i of fs < 10 then put "0" before item i of fs

end repeat

return item 1 of fs&"-"&item 2 of of fs&"-"&item 3 of fs&space&item 4 of fs &":"&item 5 of fs &":"&item 6 of fs

end SecondsToISO

on RecurseOverFolders fFolderPath,fFileHandler,fFolderHandler,fCaller

-- fFolderPath is the path to the folder we want to recurse over,

-- fFileHandler is the handler to call for each file, with the file path as argument

-- fFolderHandler is the handler to call for each folder, with the folder path as argument

-- fCaller is the name of the object where the call-back handlers are located.

-- items are handled in the alphabetical order of the Finder

-- items whose name starts with "z" are excluded, the call to FolderItems excludes invisible files and "Icon(13)" files.

put the defaultfolder into lDefaultFolder

if there is a folder fFolderPath then

put fFolderPath into lRootFolder

set the defaultfolder to lRootFolder

put 1 into lFolderDepth

RecurseOverFoldersDoFolders lRootFolder,lFolderDepth,fFileHandler,fFolderHandler,fCaller

else

answer "No such folder..."

end if

set the defaultfolder to lDefaultFolder

end RecurseOverFolders

on RecurseOverFoldersDoFolders fFolderPath,fFolderDepth,fFileHandler,fFolderHandler,fCaller

-- get the alphabetical mixed list of files and folders:

put empty into lItems

FolderItems fFolderPath,lItems

put the keys of lItems into lItemKeys; put (the number of lines of lItemKeys)/2 into nItems

-- lItems[i,1] is either "f" for a file, or "d" for a directory (folder)

-- lItems[i,2] is the name of the item

repeat with iItem=1 to nItems

if char 1 of lItems[iItem,2] = "z" then next repeat

if lItems[iItem,1] = "f" then

put fFileHandler & space & quote&fFolderPath&(lItems[iItem,2])&quote&","&fFolderDepth into lCall; send lCall to fCaller

else

put fFolderHandler & space & quote&fFolderPath&(lItems[iItem,2])&"/"&quote&","&fFolderDepth into lCall; send lCall to fCaller

RecurseOverFoldersDoFolders fFolderPath&(lItems[iItem,2])&"/",fFolderDepth+1,fFileHandler,fFolderHandler,fCaller

end if

end repeat

end RecurseOverFoldersDoFolders

function RelativePath fStartFolder,fDestinationFolder

-- Computes the path difference from position fStartFolder to fDestinationFolder in the file tree

-- We are at fStartFolder, how to get to fDestinationFolder? This relative path can be of the

-- form "../../folder/folder" if we have to go up to a common parent first.

-- Both positions are given as paths without file names e.g. "folder/folder/...folder/"

-- and it is assumed that at least the first folder is common

-- (but it is not necessarily the root of the file system).

-- The algorithm tries to find the first point at which the paths differ.

-- During the comparison we may reach the end of one of the paths, i.e. the shorter path

-- is completely contained in the longer one. If the destination is longer, then we just use the

-- remaining part of the destination, since it is inside the start folder. An example is:

-- start: a/b/c/

-- destination: a/b/c/d/e/f/

-- relative path: d/e/f/

--

-- If the start is longer, then it is inside the destination and all we need to do is go up the

-- tree to that point. An example is:

-- start: a/b/c/d/e/f/

-- destination: a/b/c/

-- relative path: ../../../

--

-- In the remaining case a difference is found somewhere before reaching the end of either path.

-- Then first one has to go back up from the start folder to this common point and then down

-- to the destination. An example is:

-- start: a/x/y/

-- destination: a/b/c/d/e/f/

-- relative path: ../../b/c/d/e/f/

local lRelativePath -- where we prepare the result

local nStartItems -- the number of folders in the start folder path

local nDestinationItems -- the number of folders in the destination folder path

local lComparing -- the index of the item in both paths that is being compared

set the itemdelimiter to "/"

put the number of items of fStartFolder into nStartItems

put the number of items of fDestinationFolder into nDestinationItems

put 0 into lComparing

put empty into lRelativePath

repeat

add 1 to lComparing

if lComparing > nStartItems then

-- everything up to here was the same and the destination is longer:

-- the relative part is just the rest of the destination path:

repeat while lComparing <= nDestinationItems

put (item lComparing of fDestinationFolder)&"/" after lRelativePath

add 1 to lComparing

end repeat

exit repeat -- we have finished.

else

if lComparing > nDestinationItems then

-- everything up to here was the same and the destination is shorter,

-- we just need to go up the tree a little because we started inside the destination

repeat while lComparing <= nStartItems

put "../" after lRelativePath

add 1 to lComparing

end repeat

exit repeat -- we have finished.

else

if item lComparing of fStartFolder ≠ item lComparing of fDestinationFolder then

-- the paths are different at this point.

-- first go up the tree from inside the start folder up to this common point:

repeat with j=0 to nStartItems-lComparing

put "../" after lRelativePath

end repeat

-- now go down the destination path:

repeat while lComparing <= nDestinationItems

put (item lComparing of fDestinationFolder)&"/" after lRelativePath

add 1 to lComparing

end repeat

exit repeat -- we have finished.

end if

end if

end if

end repeat

return lRelativePath

end RelativePath

function Clip fLow,fN,fHigh

if fN<fLow then return fLow

if fN>fHigh then return fHigh

return fN

end Clip

function Ceiling fN

-- returns the closest integer further away from 0 than or equal to the number fN:

-- ceiling(4.1) = 5; ceiling(4.0) = 4; ceiling(-2.2) = -3;

if fN - trunc(fN) = 0 then -- a whole number

return fN

else

if fN>=0 then

return trunc(fN)+1

else

return trunc(fN)-1

end if

end if

end Ceiling

function Hex fN

-- return the hexadecimal value of fN, which is between 0 and 255:

return (char (fN div 16)+1 of "0123456789ABCDEF") & (char (fN mod 16)+1 of "0123456789ABCDEF")

end Hex

function Overlap fRect1,fRect2

-- True if the rectangles overlap.

-- It is easier to compute when two rectangles do not overlap:

-- the left of one must be to the right of the right of the other, or

-- the right must be to the left of the left, or ...

-- at least one of these must be true.

return not (item 1 of fRect1 > item 3 of fRect2 or\

item 2 of fRect1 > item 4 of fRect2 or\

item 3 of fRect1 < item 1 of fRect2 or\

item 4 of fRect1 < item 2 of fRect2 )

end Overlap