I am scripting the creation of diagrams, and regularly need to store, edit, and choose from named sets of settings (styles, in short).
Here is a sketch of a way of storing the styles in a PLIST file inside a script bundle (.scptd format).
Note that the code must be saved as an .scptd bundle rather than as a .scpt file. (Haven’t tested it as an application bundle, but I think, in principle, that should work too).
property pPlistPath : (POSIX path of (path to me)) & "Contents/Styles.plist"
property pLeft : 1
property pCentre : 2
property pRight : 3
property pTop : 4
property pBottom : 5
-- Arbitrary set of key-value pairs, which will become
-- the property names and property values of a custom style object
-- variants of which can be serialized as entries in a plist file
property plstDefaults : {¬
{"NumbersVisible", true}, ¬
{"AlignVert", pCentre}, ¬
{"AlignHoriz", pLeft}, ¬
{"XYOffset", {-0.15, -0.15}}, ¬
{"XYSize", {0.25, 0.25}}, ¬
{"NumFontName", "Gill Sans"}, ¬
{"NumFontColor", "Dark Gray"}, ¬
{"NumFontSize", 14}, ¬
{"LineColor", "Red"}, ¬
{"LineWeight", 2} ¬
}
property pstrStyleEdit : "Edit current style"
property pstrStyleDelete : "Delete current style"
property plstStyleOps : {pstrStyleEdit, pstrStyleDelete}
property pstrBar : "_____________"
property pstrOther : "Continue"
on run
tell sPlistStyles
Initialize(plstDefaults, pPlistPath) -- Check that this script is in a bundle, and that we have a plist with at least a default style
set blnEsc to false
repeat while blnEsc = false
-- GET DEFINITION OF CURRENT STYLE AS AS STRING
set strSummary to GetSummary()
-- AND GET LIST OF AVAILABLE STYLES
set lstStyles to GetStyleNames()
-- AND INCLUDE STYLE OPERATIONS IN MENU
set lstMenu to lstStyles & {pstrBar} & plstStyleOps & {pstrBar} & {pstrOther}
tell application id "sevs"
activate
set varChoice to choose from list lstMenu with prompt strSummary with title "Diagram style"
end tell
if varChoice = false then return
set varChoice to first item of varChoice
-- EITHER EDIT/DELETE THE CURRENT STYLE
if varChoice is in plstStyleOps then
if varChoice = pstrStyleEdit then
EditStyle(strSummary) -- TO CREATE A NEW STYLE, EDIT THE NAME OF ANY EXISTING STYLE.
else if varChoice = pstrStyleDelete then
DeleteCurrentStyle()
end if
else
-- OR CHOOSE A DIFFERENT STYLE
if varChoice is in lstStyles then
ChooseStyle(varChoice)
else
-- OR MOVE ON TO OTHER MATTERS, USING THE CURRENT STYLE
if varChoice = pstrOther then set blnEsc to true
end if
end if
end repeat
set oStyle to GetStyle()
end tell
-- e.g.
LineColor of oStyle
end run
script sPlistStyles
property pSettingsPath : ""
property pDefaults : {}
on Initialize(lstKeyValueDefaults, strPlistPath)
if IsBundle() then
set my pSettingsPath to strPlistPath
set pDefaults to lstKeyValueDefaults
if FileExists(pSettingsPath) of sPlistStyles then
-- Try to get the default values from the plist
ChooseStyle("Default") of sPlistStyles
set blnFound to (count of (KeyValuePairs of my sCurrentStyle)) > 0
else
set blnFound to false
end if
if not blnFound then
tell my sCurrentStyle
set its KeyValuePairs to pDefaults
my StoreKeyValueSet(StyleName of it, its KeyValuePairs, pSettingsPath)
end tell
end if
else
error "Script not saved in .scptd bundle format."
end if
end Initialize
on GetSummary()
tell my sCurrentStyle
set strStyleName to StyleName of it
"CURRENT STYLE: \"" & strStyleName & "\"" & return & my List2Lines(KeyValuePairs of it, "")
end tell
end GetSummary
on GetStyle()
Settings() of my sCurrentStyle
end GetStyle
on ChooseStyle(strChoice)
set varPairs to ReadKeyValueSet(strChoice, pSettingsPath)
tell my sCurrentStyle
if varPairs is missing value then
set KeyValuePairs of it to pDefaults
else
set KeyValuePairs of it to varPairs
end if
set oStyleObject of it to missing value
set StyleName of it to strChoice
end tell
end ChooseStyle
on DeleteCurrentStyle()
set strStyleName to StyleName of my sCurrentStyle
if strStyleName ≠"Default" then
DeleteKeyValueSet(strStyleName, pSettingsPath)
tell my sCurrentStyle
set KeyValuePairs of it to my pDefaults
set oStyleObject of it to missing value
set StyleName of it to "Default"
end tell
end if
end DeleteCurrentStyle
on IsBundle()
if IsFolder(POSIX path of (path to me)) then
return true
else
tell application id "sevs"
activate
display dialog "This script must be saved as a script bundle." & return & return & ¬
"(.scptd rather than .scpt)" with title "Wrong script file format" buttons {"OK"} default button "OK"
end tell
return false
end if
end IsBundle
-- Note: the Finder's exists() function can not see inside the (script) bundle
on FileExists(strPath)
(do shell script ("test -e " & quoted form of strPath & "; echo $?")) = "0"
end FileExists
on IsFolder(strPath)
(do shell script ("test -d " & quoted form of strPath & "; echo $?")) = "0"
end IsFolder
script sCurrentStyle
property StyleName : "Default"
property KeyValuePairs : {}
property oStyleObject : missing value
on Settings()
if oStyleObject is missing value then set oStyleObject to MakeObject() of sPlistStyles
return oStyleObject
end Settings
end script
on MakeObject()
set strScript to "script" & return
repeat with oPair in KeyValuePairs of sCurrentStyle
set {strKey, varValue} to oPair
set cClass to class of varValue
if cClass is text then
set strValue to quote & varValue & quote
else if cClass is list then
if length of varValue > 0 then
set str to "{"
repeat with i from 1 to length of varValue
set str to str & item i of varValue & ", "
end repeat
set strValue to (text 1 thru -3 of str) & "}"
else
set strValue to "{}"
end if
else
set strValue to varValue
end if
set strScript to strScript & "property " & strKey & ": " & strValue & return
end repeat
set strScript to (strScript & "end script")
run script strScript
end MakeObject
on GetStyleNames()
set lstNames to ListKeyValueSets(pSettingsPath)
set my text item delimiters to linefeed
set lstNames to paragraphs of (do shell script "echo " & quoted form of (lstNames as text) & " | sort")
set my text item delimiters to space
lstNames
end GetStyleNames
-- Add a named list of key-value pairs to the PLIST file with the specified path (creating the PLIST file if needed)
on StoreKeyValueSet(strSetName, KeyValuePairs, strPlistPath)
set oPlist to GetPlistFile(strPlistPath)
tell application id "sevs"
tell contents of oPlist
tell property list items of contents of (make new property list item at end of property list items with properties {kind:record, name:strSetName})
repeat with i from 1 to length of KeyValuePairs
set {strKey, varValue} to item i of KeyValuePairs
make new property list item at end with properties {name:strKey, value:varValue}
end repeat
end tell
end tell
end tell
end StoreKeyValueSet
-- Delete (if it exists) the named list of key-value pairs from the PLIST file with the specified path
on DeleteKeyValueSet(strSetName, strPlistPath)
if FileExists(strPlistPath) then
set oPlist to GetPlistFile(strPlistPath)
tell application id "sevs"
tell contents of contents of oPlist
if (count of (property list items where name = strSetName)) > 0 then
set strDomain to text 1 thru -7 of strPlistPath -- remove .plist extension
do shell script "defaults delete " & quoted form of strDomain & space & quoted form of strSetName
end if
end tell
end tell
else
WarnNoPlist(strPlistPath)
end if
end DeleteKeyValueSet
-- Read if it exists the named list of key-value pairs from the PLIST file with the specified path
on ReadKeyValueSet(strSetName, strPlistPath)
if FileExists(strPlistPath) then
set oPlist to GetPlistFile(strPlistPath)
tell application id "sevs"
tell contents of contents of oPlist
set refMatches to a reference to (property list items where name = strSetName)
if (count of refMatches) > 0 then
set {lstName, lstValue} to {name, value} of (property list items of (first item of refMatches))
repeat with i from 1 to length of lstName
set item i of lstName to {item i of lstName, item i of lstValue}
end repeat
return lstName
else
return missing value
end if
end tell
end tell
else
WarnNoPlist(strPlistPath)
end if
end ReadKeyValueSet
-- Get a list of any named sets of key-value pairs in the PLIST file with the specified path
on ListKeyValueSets(strPlistPath)
if FileExists(strPlistPath) then
set oPlist to GetPlistFile(strPlistPath)
tell application id "sevs" to return name of (property list items of contents of contents of oPlist) -- returns a list
else
WarnNoPlist(strPlistPath)
end if
end ListKeyValueSets
on WarnNoPlist(strPlistPath)
tell application id "sevs"
activate
display alert "PLIST file not found: " & return & return & strPlistPath
end tell
return false
end WarnNoPlist
on GetPlistFile(strPathName)
tell application id "sevs"
if my FileExists(strPathName) then
return property list file strPathName
else
set oDict to make new property list item with properties {kind:record}
return (make new property list file with properties {contents:oDict, name:strPathName})
end if
end tell
end GetPlistFile
on EditStyle(strSummary)
tell application id "sevs"
activate
set varNew to display dialog "(To create a new style, edit the name of the current style)
Edit settings:" default answer strSummary with title pstrStyleEdit
set strEdited to text returned of varNew
end tell
-- Convert the edited lines back to a list of pairs
set lstSettings to Lines2List(strEdited)
-- assign the list of pairs back to the class and clear oStyleObject
if length of lstSettings > 0 then
set lstPairs to items 2 thru -1 of lstSettings
tell my sCurrentStyle
set KeyValuePairs of it to lstPairs
set oStyleObject of it to missing value
set strStyleName to item 2 of first item of lstSettings
set StyleName of it to strStyleName
end tell
StoreKeyValueSet(strStyleName, lstPairs, pSettingsPath)
end if
end EditStyle
on List2Lines(KeyValuePairs, strPrefix)
set str to ""
repeat with oPair in KeyValuePairs
set {strKey, varValue} to oPair
set cClass to class of varValue
if cClass is text then
set strValue to quote & varValue & quote
else if cClass is list then
set strValue to ListAsString(varValue)
else
set strValue to varValue
end if
set str to str & strPrefix & strKey & ": " & strValue & linefeed
end repeat
do shell script "echo " & quoted form of str & " | sort "
end List2Lines
on Lines2List(strLines)
set lstLines to paragraphs of strLines
if (count of lstLines) < 1 then return {}
repeat while last item of lstLines = ""
set lstLines to items 1 thru -2 of lstLines
end repeat
set my text item delimiters to ": "
set lst to {}
repeat with i from 1 to length of lstLines
set lstPair to text items of item i of lstLines
if length of lstPair = 2 then
set item 2 of lstPair to run script item 2 of lstPair
set end of lst to lstPair
end if
end repeat
lst
end Lines2List
on ListAsString(varValue)
if length of varValue > 0 then
set str to "{"
repeat with i from 1 to length of varValue
set str to str & item i of varValue & ", "
end repeat
(text 1 thru -3 of str) & "}"
else
"{}"
end if
end ListAsString
end script