Script to copy/paste tags to select columns (redux!)


#21

Aha. I didn’t realize it might require so much additional work, though I see your point re: how any of these processes could lead to potential glitches.

I’d consider buying TaskPaper and using it to create the kind of tab-indented outline for the subject categories and their respective tags. Just so I understand you correctly, in reading what you’ve just produced above, I would:

(1) Create a document – a tab-indented outline – in which I’d flesh out the subject categories and their respective tags, and (2) after saving it, I’d run the script that you just posted.

Would the most recent script then inform the commands in the original script – or is the most recent script a standalone that would replace the original script?

Just want to be sure I’m following you properly. Thank you again for your help…


#22

Just following up here, so that I can understand how your latest script would work. If I follow you properly, I would

-first use TaskPaper or some other app to create a tab-indented outline for categories and their respective tags;

-save that tab-indented outline as a text file;

-Run the script you sent so that it could read the tab-indented outline text, while making sure that the right OO file is open;

Is that right?

Thanks again!


#23

@draft8 - sorry to bug you. Just wanted to follow up on my last questions re: how to use your script vis-a-visTaskPaper.

I’ve download TaskPaper, and created an outline document in which I created subject categories are parents (parents) and their respective tags (children). I also copied your last script, pasted it into Script Editor, and then hit compile – while the TaskPaper and OmniOutliner files were open.

Then what do I do from there? Are there certain elements that I need to fill out in the latest script so that it can reference the TaskPaper and OmniOutliner files?

Many thanks again…


#24

Can you upload here samples of:

  • a TaskPaper file
  • a basic OO file ?

Easier to sketch something working for you with data of the right shape.


#25

Sure thing! Here you go…

Food Sample.ooutline (3.0 KB)

And…


#26

And here’s a copy of the latest script you uploaded, just in case that’s helpful…

Let me know if I can provide you with anything else. And thanks again for your help!


#27

First draft below (reading Thesaurus in from a TaskPaper outline).

  1. Edit the fpThesaurus line at the top to match the path of your TaskPaper file (you can use the ~ tilde character to represent your user directory. TaskPaper itself is probably best closed while you are using the saved Thesaurus file (at least in initial testing). This script reads from the saved TaskPaper file, rather than from the live application document.
  2. With the OO document open, first try running the script below in Script Editor.

Then, once it seems to be working as you want, you can save the script as an .scpt file, and use something like FastScripts to assign it to a key-stroke.

(FastScripts is free for use with up to about 10 scripts, I think)

(Make sure you have copied the entire script revealed by the disclosure triangle below – the last line is end unlines)

AppleScript source code
use AppleScript version "2.4"
use framework "Foundation"
use scripting additions

property fpThesaurus : "~/Desktop/Test TP.taskpaper"


-- Rob Trew 2020

-- Ver 0.04 Importing a Thesaurus outline from a TaskPaper file
-- 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)


---------------------------TEST----------------------------
on run
    either(alert("Tag columns"), ¬
        columnsFromTags, ¬
        thesaurusFromFilePath(fpThesaurus))
end run

----------------------OO TAG COLUMNS-----------------------

-- columnsFromTags :: [(String, [String])] -> OmniOutliner IO ()
on columnsFromTags(thesaurusEntries)
    tell application "OmniOutliner"
        if 0 < (count of documents) then
            my updatedTagColsFromThesaurus(thesaurusEntries, front document)
        else
            "No document open in OmniOutliner"
        end if
    end tell
end columnsFromTags

-- thesaurusFromFilePath :: FilePath -> Either String [(String, [String])]
on thesaurusFromFilePath(fp)
    if doesFileExist(fp) then
        set strThesaurus to readFile(fpThesaurus)
        set trees to ¬
            forestFromLineIndents(indentLevelsFromLines(paragraphs of strThesaurus))
        script tagGroup
            on |λ|(tree)
                script go
                    on |λ|(x, xs)
                        Tuple(x, map(my fst, xs))
                    end |λ|
                end script
                foldTree(go, tree)
            end |λ|
        end script
        |Right|(map(tagGroup, trees))
    else
        |Left|("Thesaurus outline not found at " & fpThesaurus)
    end if
end thesaurusFromFilePath

-- 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

-- Left :: a -> Either a b
on |Left|(x)
    {type:"Either", |Left|:x, |Right|:missing value}
end |Left|

-- Right :: b -> Either a b
on |Right|(x)
    {type:"Either", |Left|:missing value, |Right|:x}
end |Right|

-- Node :: a -> [Tree a] -> Tree a
on Node(v, xs)
    {type:"Node", root:v, nest:xs}
end Node

-- 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

-- alert :: String -> String -> IO ()
on alert(strTitle)
    script
        on |λ|(s)
            tell current application
                activate
                display dialog s with title strTitle buttons {"OK"} default button "OK"
                return s
            end tell
        end |λ|
    end script
end alert

-- compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
on compose(f, g)
    script
        property mf : mReturn(f)
        property mg : mReturn(g)
        on |λ|(x)
            mf's |λ|(mg's |λ|(x))
        end |λ|
    end script
end compose

-- 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

-- div :: Int -> Int -> Int
on |div|(a, b)
    a div b
end |div|

-- doesFileExist :: FilePath -> IO Bool
on doesFileExist(strPath)
    set ca to current application
    set oPath to (ca's NSString's stringWithString:strPath)'s ¬
        stringByStandardizingPath
    set {bln, int} to (ca's NSFileManager's defaultManager's ¬
        fileExistsAtPath:oPath isDirectory:(reference))
    bln and (int ≠ 1)
end doesFileExist


-- either :: (a -> c) -> (b -> c) -> Either a b -> c
on either(lf, rf, e)
    if missing value is |Left| of e then
        tell mReturn(rf) to |λ|(|Right| of e)
    else
        tell mReturn(lf) to |λ|(|Left| of e)
    end if
end either


-- Lift a simple function to one which applies to a tuple, 
-- transforming only the first item of the tuple
-- firstArrow :: (a -> b) -> ((a, c) -> (b, c))
on firstArrow(f)
    script
        on |λ|(xy)
            Tuple(mReturn(f)'s |λ|(|1| of xy), |2| of xy)
        end |λ|
    end script
end firstArrow


-- flip :: (a -> b -> c) -> b -> a -> c
on flip(f)
    script
        property g : mReturn(f)
        on |λ|(x, y)
            g's |λ|(y, x)
        end |λ|
    end script
end flip

-- 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

-- foldTree :: (a -> [b] -> b) -> Tree a -> b
on foldTree(f, tree)
    script go
        property g : mReturn(f)'s |λ|
        on |λ|(oNode)
            g(root of oNode, map(go, nest of oNode))
        end |λ|
    end script
    |λ|(tree) of go
end foldTree

-- forestFromLineIndents :: [(Int, String)] -> [Tree String]
on forestFromLineIndents(tuples)
    script go
        on |λ|(xs)
            if 0 < length of xs then
                set {n, s} to listFromTuple(item 1 of xs)
                script lessIndented
                    on |λ|(x)
                        n < fst(x)
                    end |λ|
                end script
                set {firstTreeLines, rs} to ¬
                    listFromTuple(|λ|(rest of xs) of span(lessIndented))
                {Node(s, |λ|(firstTreeLines))} & |λ|(rs)
            else
                {}
            end if
        end |λ|
    end script
    |λ|(tuples) of go
end forestFromLineIndents

-- 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

-- identity :: a -> a
on identity(x)
    -- The argument unchanged.
    x
end identity

-- indentLevelsFromLines :: [String] -> [(Int, String)]
on indentLevelsFromLines(xs)
    set indentTextPairs to map(compose(firstArrow(my |length|), span(my isSpace)), xs)
    script indentSize
        on |λ|(tpl)
            set w to fst(tpl)
            if 0 < w then
                {w}
            else
                {}
            end if
        end |λ|
    end script
    set indentUnit to minimum(concatMap(indentSize, indentTextPairs))
    script indentDepth
        on |λ|(x)
            x div indentUnit
        end |λ|
    end script
    map(firstArrow(indentDepth, indentTextPairs), indentTextPairs)
end indentLevelsFromLines


-- 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

-- isSpace :: Char -> Bool
on isSpace(c)
    set i to id of c
    32 = i or (9 ≤ i and 13 ≥ i)
end isSpace

-- length :: [a] -> Int
on |length|(xs)
    set c to class of xs
    if list is c or string is c then
        length of xs
    else
        (2 ^ 29 - 1) -- (maxInt - simple proxy for non-finite)
    end if
end |length|

-- 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

-- minimum :: Ord a => [a] -> a
on minimum(xs)
    set lng to length of xs
    if lng < 1 then return missing value
    set m to item 1 of xs
    repeat with x in xs
        set v to contents of x
        if v < m then set m to v
    end repeat
    return m
end minimum

-- 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

-- readFile :: FilePath -> IO String
on readFile(strPath)
    set ca to current application
    set e to reference
    set {s, e} to (ca's NSString's ¬
        stringWithContentsOfFile:((ca's NSString's ¬
            stringWithString:strPath)'s ¬
            stringByStandardizingPath) ¬
            encoding:(ca's NSUTF8StringEncoding) |error|:(e))
    if missing value is e then
        s as string
    else
        (localizedDescription of e) as string
    end if
end readFile

-- 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

-- span :: (a -> Bool) -> [a] -> ([a], [a])
on span(f)
    -- The longest (possibly empty) prefix of xs
    -- that contains only elements satisfying p,
    -- tupled with the remainder of xs.
    -- span(p, xs) eq (takeWhile(p, xs), dropWhile(p, xs)) 
    script
        on |λ|(xs)
            set lng to length of xs
            set i to 0
            tell mReturn(f)
                repeat while lng > i and |λ|(item (1 + i) of xs)
                    set i to 1 + i
                end repeat
            end tell
            splitAt(i, xs)
        end |λ|
    end script
end span

-- splitAt :: Int -> [a] -> ([a], [a])
on splitAt(n, xs)
    if n > 0 and n < length of xs then
        if class of xs is text then
            Tuple(items 1 thru n of xs as text, ¬
                items (n + 1) thru -1 of xs as text)
        else
            Tuple(items 1 thru n of xs, items (n + 1) thru -1 of xs)
        end if
    else
        if n < 1 then
            Tuple({}, xs)
        else
            Tuple(xs, {})
        end if
    end if
end splitAt

-- 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

#28

My God. This…is amazing. It works perfectly!

Thank you, thank you, thank you!!! This solves so many problems, and significantly improves my work process. I’m very grateful…

Now if only OmniOutliner could create alias notes I’d be really set! Ah well, can’t have everything I suppose.

Anyway, I thank you very much again.