In the meanwhile, I won’t have time to support this, so it may well not be a good choice in practice (unless you want to learn some scripting yourself), but here FWIW is a rough draft in AppleScript, which others are welcome to improve.
(You would have to edit the thesaurus()
definition at the top to meet your needs).
(and, again, you would need to copy everything all the way down to end unlines
)
-- Ver 0.03 (Creating an 'Other' column for tags not found (as spelled) in thesaurus)
-- Ver 0.02 (Reporting any tags not found in thesaurus)
-- thesaurus :: () -> [(String, [String])]
on thesaurus()
set fruit to Tuple("Fruit", {"Apples", "Bananas", "Grapes"})
set veg to Tuple("Vegetables", {"Cabbage", "Cauliflower", "Sprouts"})
set clubs to Tuple("Clubs", {"Arsenal", "Liverpool", "Spurs"})
{fruit, veg, clubs}
end thesaurus
---------------------------TEST----------------------------
on run
tell application "OmniOutliner"
if 0 < (count of documents) then
my updatedTagColsFromThesaurus(my thesaurus(), front document)
else
"No document open in OmniOutliner"
end if
end tell
end run
---------------TAG COLUMNS FOUND (OR CREATED)---------------
-------------AND UPDATED IN TERMS OF THESAURUS-------------
-- updateTagColsFromThesaurus :: [(String, [String])] -> OO Doc -> IO String
on updatedTagColsFromThesaurus(lexicon, oDoc)
using terms from application "OmniOutliner"
set colNames to {"Tags"} & my map(my fst, lexicon)
set tagCols to my map(my columnFoundOrCreated(oDoc), colNames)
script go
on |λ|(oRow)
set {lstUnallocated, lstTaggings} to my listFromTuple(tagParse(lexicon, ¬
value of cell "Tags" of oRow))
----------ROW UPDATED FROM THESAURUS ENTRIES-----------
script tagUpdates
on |λ|(acc, kvs)
set {label, vs} to kvs
set value of cell label of acc to my intercalate(";", vs)
acc
end |λ|
end script
my foldl(tagUpdates, oRow, lstTaggings)
--------ANY REMAINING TAGS WITH NO THESAURUS ENTRY---------
if 0 < length of lstUnallocated then
set colOther to |λ|("Other") of columnFoundOrCreated(oDoc)
set strOther to intercalate(";", lstUnallocated)
set value of cell "Other" of oRow to strOther
set strMsg to anyUnallocated(strOther)
else
set strMsg to ""
end if
----------------------LOG OF RESULTS-----------------------
set strTopic to topic of oRow
if 0 < length of strTopic then
script report
on |λ|(colName)
set mb to (value of (cell colName of oRow)) as string
if 0 < length of mb then
{tab & colName & " : " & mb}
else
{}
end if
end |λ|
end script
{strTopic & " ->\n" & my unlines(my concatMap(report, ¬
rest of colNames)) & linefeed & strMsg}
else
{}
end if
end |λ|
end script
my unlines(my concatMap(go, rows of oDoc))
end using terms from
end updatedTagColsFromThesaurus
-- anyUnallocated :: String -> String
on anyUnallocated(s)
if 0 < length of s then
"\tOTHER: " & s & linefeed
else
""
end if
end anyUnallocated
------------------------OO GENERIC-------------------------
-- columnFoundOrCreated :: OO Doc -> String -> OO Column
on columnFoundOrCreated(oDoc)
script go
on |λ|(strColName)
using terms from application "OmniOutliner"
set cols to columns of oDoc where name is strColName
if 0 < (count of cols) then
item 1 of cols
else
tell oDoc to make new column with properties {name:strColName}
end if
end using terms from
end |λ|
end script
end columnFoundOrCreated
-------------------------TAG PARSE-------------------------
-- tagParse ::[(String, [String])] -> String -> ([String], [(String, [String])])
on tagParse(lexicon, strTags)
-- Tuple resulting from a parse of a semi-colon delimited string
-- in terms of a thesaurus.
-- (Remaining unallocated tags, plus a list of (label, instances) pairs)
set ks to splitOn(";", strTags)
script go
on |λ|(a, tpl)
set residue to fst(a)
if 0 < length of residue then
set examples to snd(tpl)
script p
on |λ|(x)
examples contains x
end |λ|
end script
set tplParts to partition(p, residue)
set harvest to fst(tplParts)
set unallocated to snd(tplParts)
if 0 < length of harvest then
Tuple(unallocated, snd(a) & {{fst(tpl), harvest}})
else
a
end if
else
a
end if
end |λ|
end script
foldl(go, Tuple(ks, {}), lexicon)
end tagParse
--------------------------GENERIC--------------------------
-- https://github.com/RobTrew/prelude-applescript
-- Tuple (,) :: a -> b -> (a, b)
on Tuple(a, b)
-- Constructor for a pair of values, possibly of two different types.
{type:"Tuple", |1|:a, |2|:b, length:2}
end Tuple
-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
set lng to length of xs
set acc to {}
tell mReturn(f)
repeat with i from 1 to lng
set acc to acc & (|λ|(item i of xs, i, xs))
end repeat
end tell
return acc
end concatMap
-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
tell mReturn(f)
set v to startValue
set lng to length of xs
repeat with i from 1 to lng
set v to |λ|(v, item i of xs, i, xs)
end repeat
return v
end tell
end foldl
-- fst :: (a, b) -> a
on fst(tpl)
if class of tpl is record then
|1| of tpl
else
item 1 of tpl
end if
end fst
-- intercalate :: String -> [String] -> String
on intercalate(delim, xs)
set {dlm, my text item delimiters} to ¬
{my text item delimiters, delim}
set str to xs as text
set my text item delimiters to dlm
str
end intercalate
-- listFromTuple :: (a, a ...) -> [a]
on listFromTuple(tpl)
items 2 thru -2 of (tpl as list)
end listFromTuple
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
-- The list obtained by applying f
-- to each element of xs.
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to |λ|(item i of xs, i, xs)
end repeat
return lst
end tell
end map
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
-- 2nd class handler function lifted into 1st class script wrapper.
if script is class of f then
f
else
script
property |λ| : f
end script
end if
end mReturn
-- partition :: (a -> Bool) -> [a] -> ([a], [a])
on partition(f, xs)
tell mReturn(f)
set ys to {}
set zs to {}
repeat with x in xs
set v to contents of x
if |λ|(v) then
set end of ys to v
else
set end of zs to v
end if
end repeat
end tell
Tuple(ys, zs)
end partition
-- snd :: (a, b) -> b
on snd(tpl)
if class of tpl is record then
|2| of tpl
else
item 2 of tpl
end if
end snd
-- splitOn :: String -> String -> [String]
on splitOn(pat, src)
set {dlm, my text item delimiters} to ¬
{my text item delimiters, pat}
set xs to text items of src
set my text item delimiters to dlm
return xs
end splitOn
-- unlines :: [String] -> String
on unlines(xs)
-- A single string formed by the intercalation
-- of a list of strings with the newline character.
set {dlm, my text item delimiters} to ¬
{my text item delimiters, linefeed}
set str to xs as text
set my text item delimiters to dlm
str
end unlines