Tinderbox Forum

Copying a list of all attribute:value pairs for the selected note


(RobTrew) #1

Not sure if this will be of use to anyone else - I’m find it useful for exploring what’s there.

(Can be run, for example, from Script Editor, with the language tab at top left set to JavaScript - I personally run scripts more often from Atom or Keyboard Maestro etc)

(() => {
    'use strict';

    // Copy to clipboard a list of all the non-empty (attribute: value)
    // pairs for the selected Tinderbox 8 note .

    // ver 0.03
    const main = () =>
        either(
            x => x,
            x => (
                standardAdditions().setTheClipboardTo(x),
                console.log(x),
                x
            ),
            bindLR(
                frontDocLR(),
                d => bindLR(
                    selectedNoteLR(d),
                    note => Right(unlines(sort(concat(zipWith(
                        (k, v) => 0 < v.length ? [
                            k + ': ' + v
                        ] : [],
                        note.attributes.name(),
                        note.attributes.value()
                    )))))
                )
            )
        );

    // TINDERBOX FUNCTIONS --------------------------------

    // frontDocLR :: Tbx IO () -> Either String Tbx Doc
    const frontDocLR = () => {
        // Either the front document in Tinderbox 8, or an
        // explanatory message if no documents are open,
        // or Tinderbox 8 is not running.
        const tbx = Application('Tinderbox 8');
        return tbx.running() ? (() => {
            const ds = tbx.documents;
            return 0 < ds.length ? (
                Right(ds.at(0))
            ) : Left('No documents open in Tinderbox');
        })() : Left('Tinderbox 8 is not running.');
    };

    // selectedNoteLR :: Tbx Doc -> Either String Tbx Note
    const selectedNoteLR = doc => {
        // Either the first selected note, or an
        // explanatory message if nothing is selected.
        const note = doc.selectedNote();
        return note !== null ? (
            Right(note)
        ) : Left('No note selected in ' + doc.name());
    };

    // JXA ------------------------------------------------

    // standardAdditions :: () -> Application
    const standardAdditions = () =>
        Object.assign(Application.currentApplication(), {
            includeStandardAdditions: true
        });

    // GENERIC FUNCTIONS ----------------------------------
    // https://github.com/RobTrew/prelude-jxa

    // Left :: a -> Either a b
    const Left = x => ({
        type: 'Either',
        Left: x
    });

    // Right :: b -> Either a b
    const Right = x => ({
        type: 'Either',
        Right: x
    });

    // bindLR (>>=) :: Either a -> (a -> Either b) -> Either b
    const bindLR = (m, mf) =>
        undefined !== m.Left ? (
            m
        ) : mf(m.Right);

    // concat :: [[a]] -> [a]
    // concat :: [String] -> String
    const concat = xs =>
        0 < xs.length ? (() => {
            const unit = 'string' !== typeof xs[0] ? (
                []
            ) : '';
            return unit.concat.apply(unit, xs);
        })() : [];

    // either :: (a -> c) -> (b -> c) -> Either a b -> c
    const either = (fl, fr, e) =>
        'Either' === e.type ? (
            undefined !== e.Left ? (
                fl(e.Left)
            ) : fr(e.Right)
        ) : undefined;

    // Returns Infinity over objects without finite length.
    // This enables zip and zipWith to choose the shorter
    // argument when one is non-finite, like cycle, repeat etc

    // length :: [a] -> Int
    const length = xs =>
        (Array.isArray(xs) || 'string' === typeof xs) ? (
            xs.length
        ) : Infinity;

    // sort :: Ord a => [a] -> [a]
    const sort = xs => xs.slice()
        .sort((a, b) => a < b ? -1 : (a > b ? 1 : 0));

    // take :: Int -> [a] -> [a]
    // take :: Int -> String -> String
    const take = (n, xs) =>
        'GeneratorFunction' !== xs.constructor.constructor.name ? (
            xs.slice(0, n)
        ) : [].concat.apply([], Array.from({
            length: n
        }, () => {
            const x = xs.next();
            return x.done ? [] : [x.value];
        }));

    // unlines :: [String] -> String
    const unlines = xs => xs.join('\n');

    // Use of `take` and `length` here allows zipping with non-finite lists
    // i.e. generators like cycle, repeat, iterate.

    // zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
    const zipWith = (f, xs, ys) => {
        const
            lng = Math.min(length(xs), length(ys)),
            as = take(lng, xs),
            bs = take(lng, ys);
        return Array.from({
            length: lng
        }, (_, i) => f(as[i], bs[i], i));
    };

    // MAIN ---
    return main();
})();

(RobTrew) #2

Or, FWIW, an AppleScript version:

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

-- RobTrew (Twitter @complexpoint) 2019
-- https://github.com/RobTrew
-- ver 0.01

-- TINDERBOX 8:

-- COPY ALL NON-EMPTY (ATTRIBUTE: VALUE) PAIRS OF 
-- SELECTED NOTE TO CLIPBOARD
on run
    tell application "Tinderbox 8"
        script go
            on |λ|(x)
                tell attributes of x
                    script kv
                        on |λ|(k, v)
                            if "" ≠ v then
                                {k & ": " & v}
                            else
                                {}
                            end if
                        end |λ|
                    end script
                    my |Right|(my unlines(my sort(my concat(my zipWith(kv, name, value)))))
                end tell
            end |λ|
        end script
    end tell
    
    script clip
        on |λ|(x)
            set the clipboard to x
            return x
        end |λ|
    end script
    
    return either(|id|, clip, ¬
        bindLR(bindLR(frontDocLR(), selectedNoteLR), go))
end run


-- TINDERBOX FUNCTIONS ------------------------------------

-- frontDocLR :: Tbx IO () -> Either String Tbx Doc
on frontDocLR()
    -- Either the front document in Tinderbox 8, or an
    -- explanatory message if no documents are open,
    --  or Tinderbox 8 is not running.
    tell application "Tinderbox 8"
        if running then
            set ds to documents
            if 0 < (count of documents) then
                my |Right|(item 1 of documents)
            else
                my |Left|("No documents open in Tinderbox 8")
            end if
        else
            my |Left|("Tinderbox 8 is not running.")
        end if
    end tell
end frontDocLR

-- selectedNoteLR :: Tbx Doc -> Either String Tbx Note
on selectedNoteLR(doc)
    -- Either the first selected note, or an
    -- explanatory message if nothing is selected.
    tell application "Tinderbox 8"
        set oNote to selected note of doc
        if missing value is not oNote then
            my |Right|(oNote)
        else
            my |Left|("No note selected in " & name of doc)
        end if
    end tell
end selectedNoteLR


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

-- bindLR (>>=) :: Either a -> (a -> Either b) -> Either b
on bindLR(m, mf)
    if missing value is not |Right| of m then
        mReturn(mf)'s |λ|(|Right| of m)
    else
        m
    end if
end bindLR

-- concat :: [[a]] -> [a]
-- concat :: [String] -> String
on concat(xs)
    set lng to length of xs
    if 0 < lng and string is class of (item 1 of xs) then
        set acc to ""
    else
        set acc to {}
    end if
    repeat with i from 1 to lng
        set acc to acc & item i of xs
    end repeat
    acc
end concat

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

-- id :: a -> a
on |id|(x)
    x
end |id|

-- isRight :: Either a b -> Bool
on isRight(x)
    set dct to current application's ¬
        NSDictionary's dictionaryWithDictionary:x
    (dct's objectForKey:"type") as text = "Either" and ¬
        (dct's objectForKey:"Left") as list = {missing value}
end isRight

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

-- min :: Ord a => a -> a -> a
on min(x, y)
    if y < x then
        y
    else
        x
    end if
end min

-- Lift 2nd class handler function into 1st class script wrapper 
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
    if script is class of f then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- sort :: Ord a => [a] -> [a]
on sort(xs)
    ((current application's NSArray's arrayWithArray:xs)'s ¬
        sortedArrayUsingSelector:"compare:") as list
end sort

-- take :: Int -> [a] -> [a]
-- take :: Int -> String -> String
on take(n, xs)
    set c to class of xs
    if list is c then
        if 0 < n then
            items 1 thru min(n, length of xs) of xs
        else
            {}
        end if
    else if string is c then
        if 0 < n then
            text 1 thru min(n, length of xs) of xs
        else
            ""
        end if
    else if script is c then
        set ys to {}
        repeat with i from 1 to n
            set v to |λ|() of xs
            if missing value is v then
                return ys
            else
                set end of ys to v
            end if
        end repeat
        return ys
    else
        missing value
    end if
end take

-- unlines :: [String] -> String
on unlines(xs)
    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

-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
on zipWith(f, xs, ys)
    set lng to min(|length|(xs), |length|(ys))
    if 1 > lng then return {}
    set xs_ to take(lng, xs) -- Allow for non-finite
    set ys_ to take(lng, ys) -- generators like cycle etc
    set lst to {}
    tell mReturn(f)
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs_, item i of ys_)
        end repeat
        return lst
    end tell
end zipWith


(Sumner Gerard) #3

I have trouble following the AppleScript, but here’s what I think is a rough translation into a more pedestrian dialect. Really appreciated learning how to do one-line sort!

use framework "Foundation"
use scripting additions

tell application "Tinderbox 8"
	try
		tell front document to tell first selection
			set {attrNamesLst, attrValsLst} to {name of attributes, value of attributes}
		end tell
	on error
		error "Select a Tinderbox note"
	end try
end tell

set pairLst to {}
repeat with i from 1 to length of attrNamesLst
	tell item i of attrValsLst to if it is not "" then ¬
		set end of pairLst to item i of attrNamesLst & ": " & it
end repeat

set sortedLst to ((current application's NSArray's arrayWithArray:pairLst)'s ¬
	sortedArrayUsingSelector:"compare:") as list

set text item delimiters to return
set the clipboard to sortedLst as string

return sortedLst as string -- to view in Script Editor result pane

(RobTrew) #4

It’s possible that you may find one or two other useful things in the library which that comes from.

If you are curious about snapping together these pre-existing ‘lego-blocks’ of Applescript code to build small tools for Tinderbox, then the first functions to experiment with are probably map, filter and foldl (reduce):

Examples, FWIW: (click to expand the source code)
use AppleScript version "2.4"
use framework "Foundation"
use scripting additions


-- MAP, FILTER, FOLD/REDUCE

-- (Applescript examples)
on run
    
    -- MAP ------------------------------------------------
    
    map(dbl, {1, 2, 3, 4, 5})
    
    --> {2, 4, 6, 8, 10}
    
    
    map(toUpper, {"alpha", "beta", "gamma"})
    
    --> {"ALPHA", "BETA", "GAMMA"}
    
    
    map(odd, enumFromTo(1, 10))
    
    --> {true, false, true, false, true, false, true, false, true, false}
    
    
    -- FILTER ---------------------------------------------
    
    filter(odd, enumFromTo(1, 10))
    
    --> {1, 3, 5, 7, 9}
    
    
    filter(even, enumFromTo(1, 10))
    
    --> {2, 4, 6, 8, 10}
    
    
    script longer
        on |λ|(x)
            4 < length of x
        end |λ|
    end script
    
    filter(longer, {"alpha", "beta", "gamma", "delta", "epsilon", "zeta", "eta"})
    
    --> {"alpha", "gamma", "delta", "epsilon"}
    
    
    
    -- FOLD / REDUCE (here fold left: foldl) --------------
    
    foldl(plus, 0, enumFromTo(1, 10))
    
    --> 55
    
    
    foldl(mul, 1, enumFromTo(1, 10))
    
    -- 3628800
    
    
    foldl(max, 0, {81, 27, 25, 64, 121, 16, 100})
    
    --> 121
    
end run

-- Sample functions ---------------------------------------

on dbl(x)
    2 * x
end dbl


on plus(a, b)
    a + b
end plus


on mul(a, b)
    a * b
end mul

on max(a, b)
    if b > a then
        b
    else
        a
    end if
end max


-- GENERIC ------------------------------------------------
-- https://github.com/RobTrew/prelude-applescript

-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
    if m ≤ n then
        set lst to {}
        repeat with i from m to n
            set end of lst to i
        end repeat
        return lst
    else
        return {}
    end if
end enumFromTo

-- even :: Int -> Bool
on even(x)
    0 = x mod 2
end even

-- filter :: (a -> Bool) -> [a] -> [a]
on filter(f, xs)
    tell mReturn(f)
        set lst to {}
        set lng to length of xs
        repeat with i from 1 to lng
            set v to item i of xs
            if |λ|(v, i, xs) then set end of lst to v
        end repeat
        return lst
    end tell
end filter

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

-- Lift 2nd class handler function into 1st class script wrapper 
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
    if script is class of f then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- map :: (a -> b) -> [a] -> [b]
on map(f, 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

-- odd :: Int -> Bool
on odd(x)
    not even(x)
end odd

-- toUpper :: String -> String
on toUpper(str)
    set ca to current application
    ((ca's NSString's stringWithString:(str))'s ¬
        uppercaseStringWithLocale:(ca's NSLocale's currentLocale())) as text
end toUpper

Discourse formatting shortcuts