359 lines
16 KiB
Plaintext
359 lines
16 KiB
Plaintext
(load "Lib.kiss")
|
|
|
|
(method :Void _collectAndValidateArg [:CommandArg arg :Stream stream :Dynamic->Void continuation]
|
|
(case arg.type
|
|
(SelectedEntry
|
|
(if (= 1 _selectedEntries.length)
|
|
(continuation (first _selectedEntries))
|
|
(ui.reportError "The requested command expects 1 entry to be selected. You have selected: $_selectedEntries.length")))
|
|
((SelectedEntries min max)
|
|
(unless min (set min 0))
|
|
// TODO might want to optimize this O(n) count operation by pre-calculating it
|
|
(unless max (set max (count archive.entries)))
|
|
(if !(<= min _selectedEntries.length max)
|
|
(ui.reportError "The requested command expects between $min and $max entries to be selected. You have selected: $_selectedEntries.length")
|
|
(continuation _selectedEntries)))
|
|
((Text maxLength)
|
|
(unless maxLength (set maxLength Math.POSITIVE_INFINITY))
|
|
(stream.dropWhitespace)
|
|
(localFunction :Void trySubmit [text]
|
|
(stream.dropWhitespace)
|
|
(if !(<= text.length maxLength)
|
|
(ui.reportError "The requested command expected a string up to $maxLength characters long. You entered: $text.length characters")
|
|
(continuation text)))
|
|
(if (or (stream.isEmpty) (stream.dropStringIf "_"))
|
|
// If no text argument was pre-supplied, use the ui for it
|
|
(ui.enterText
|
|
"${arg.name} (up to ${maxLength} characters):"
|
|
trySubmit
|
|
maxLength)
|
|
(trySubmit (readString stream))))
|
|
((VarText maxLength)
|
|
(unless maxLength (set maxLength Math.POSITIVE_INFINITY))
|
|
(stream.dropWhitespace)
|
|
(let [collectedText []]
|
|
(localFunction :Void enterTextAgain []
|
|
(localFunction :Void trySubmit [text]
|
|
(stream.dropWhitespace)
|
|
(if !text
|
|
(continuation collectedText)
|
|
(if !(<= text.length maxLength)
|
|
(ui.reportError "The requested command expected a list of strings up to $maxLength characters long. You entered: $text.length characters")
|
|
{(collectedText.push text)
|
|
(enterTextAgain)})))
|
|
|
|
(if (or (stream.isEmpty) (stream.dropStringIf "_"))
|
|
// If no vartext argument was pre-supplied, use the ui for it
|
|
(ui.enterText
|
|
"${arg.name} (up to ${maxLength} characters):"
|
|
trySubmit
|
|
maxLength)
|
|
(trySubmit (readString stream))))
|
|
(enterTextAgain)))
|
|
((Number min max inStepsOf)
|
|
(unless min (set min Math.NEGATIVE_INFINITY))
|
|
(unless max (set max Math.POSITIVE_INFINITY))
|
|
(stream.dropWhitespace)
|
|
(let [&mut prompt "${arg.name} (${min}-${max}"]
|
|
(when inStepsOf
|
|
(+= prompt " in steps of ${inStepsOf}"))
|
|
(+= prompt "):")
|
|
|
|
(localFunction :Void trySubmit [number]
|
|
(stream.dropWhitespace)
|
|
(let [minMaxError
|
|
"The requested command expected a number between $min and $max"
|
|
stepError
|
|
"$minMaxError in steps of $inStepsOf"
|
|
youEntered
|
|
". You entered: $number"]
|
|
(if (or
|
|
!(<= min number max)
|
|
(and inStepsOf !(= 0 (% (- number min) inStepsOf))))
|
|
(if inStepsOf
|
|
(ui.reportError "${stepError}$youEntered")
|
|
(ui.reportError "${minMaxError}$youEntered"))
|
|
(continuation number))))
|
|
|
|
// If no text argument was pre-supplied, use the ui for it
|
|
(if (or (stream.isEmpty) (stream.dropStringIf "_"))
|
|
(ui.enterNumber
|
|
prompt
|
|
trySubmit
|
|
min
|
|
max
|
|
inStepsOf)
|
|
(trySubmit (readNumber stream)))))
|
|
|
|
(OneEntry
|
|
(ui.chooseEntry
|
|
"${arg.name}:"
|
|
archive
|
|
continuation))
|
|
((Entries min max)
|
|
(unless min (set min 1))
|
|
// TODO might want to optimize this O(n) count operation by pre-calculating it
|
|
(unless max (set max (count archive.entries)))
|
|
(ui.chooseEntries
|
|
"${arg.name}:"
|
|
archive
|
|
(lambda :Void [:Array<Entry> entries]
|
|
(if (or
|
|
(> min entries.length)
|
|
(< max entries.length))
|
|
|
|
(ui.reportError "The requested command expects between $min and $max entries. You chose: $entries.length")
|
|
(continuation entries)))
|
|
min
|
|
max))
|
|
(null)))
|
|
|
|
// TODO try catch and ui.reportError
|
|
// TODO maaaybe support escape sequences?
|
|
(function readString [:Stream stream]
|
|
(let [terminator
|
|
(case (stream.takeChars 1)
|
|
((Some "\"") "\"")
|
|
((Some "'") "'")
|
|
(otherwise (throw "string arg must start with \" or '")))]
|
|
(case (stream.takeUntilAndDrop terminator)
|
|
((Some s) s)
|
|
(otherwise (throw "string arg must end with $terminator")))))
|
|
|
|
// TODO try catch and ui.reportError
|
|
(function readNumber [:Stream stream]
|
|
(Std.parseFloat (case (stream.takeUntilOneOf [" "] true) ((Some f) f) (otherwise ""))))
|
|
|
|
(method :Void->Void _composeArgCollector [:Array<Dynamic> collectedArgs :CommandArg arg :Stream stream :Void->Void lastCollector]
|
|
(lambda :Void []
|
|
(_collectAndValidateArg arg stream ->:Void [:Dynamic argValue] {(collectedArgs.push argValue) (lastCollector)})))
|
|
|
|
(method :Void tryRunCommand [:String command]
|
|
(let [parts (command.split " ")
|
|
commandName (parts.shift)
|
|
stream (Stream.fromString (parts.join " "))
|
|
lowerCommandName (commandName.toLowerCase)]
|
|
(if (commands.exists lowerCommandName)
|
|
(_runCommand (dictGet commands lowerCommandName) stream)
|
|
(ui.reportError "$commandName is not a valid command"))))
|
|
|
|
(method :Void _runCommand [:Command command :Stream stream]
|
|
(let [collectedArgs
|
|
[]
|
|
&mut lastCollector
|
|
(lambda []
|
|
(let [result (Reflect.callMethod null command.handler collectedArgs)]
|
|
(assert !(Prelude.isNull result) "Command implementation forgot to return a ChangeSet")
|
|
(set lastChangeSet (the ChangeSet result))
|
|
|
|
(when lastChangeSet
|
|
(doFor e lastChangeSet
|
|
(assert (and e (isEntry e)) "Lib function forgot to return the Entry that was modified"))
|
|
(ui.handleChanges archive lastChangeSet))))]
|
|
// To facilitate asynchronous arg input via UI, we need to construct an insanely complicated nested callback to give the UI
|
|
(doFor arg (reverse command.args)
|
|
(set lastCollector (_composeArgCollector collectedArgs arg stream lastCollector)))
|
|
(lastCollector)))
|
|
|
|
|
|
// TODO SelectedEntry and SelectedEntries functions should be stateful and use the actual
|
|
// selected entries automatically
|
|
(defMacro defCommand [name args &body body]
|
|
(let [argPairs
|
|
(groups (expList args) 2)
|
|
methodArgs
|
|
(for [name type] argPairs
|
|
(exprCase type
|
|
((exprOr SelectedEntry OneEntry) `:nat.Entry ,name)
|
|
((exprOr (SelectedEntries _ _) (Entries _ _)) `:Array<nat.Entry> ,name)
|
|
((Text _) `:String ,name)
|
|
((VarText _) `:Array<String> ,name)
|
|
((Number _ _ _) `:Float ,name)))
|
|
commandArgs
|
|
(for [name type] argPairs
|
|
`(object name ,(symbolName name) type ,type))]
|
|
`{
|
|
(method ,name [,@methodArgs] ,@body)
|
|
// Preserve the capitalization of the command name for pretty help message
|
|
(commandNames.push ,(symbolName name))
|
|
// Store the command name without capitalization for forgiving call conventions
|
|
(dictSet commands ,(ReaderExp.StrExp (.toLowerCase (symbolNameValue name))) (object args [,@commandArgs] handler (the Function ,name)))}))
|
|
|
|
(var :Array<String> commandNames [])
|
|
|
|
(method isSelected [:Entry e]
|
|
!(= -1 (_selectedEntries.indexOf e)))
|
|
|
|
(method getSelectedEntries []
|
|
(_selectedEntries.copy))
|
|
|
|
(prop &mut :PlaygroundSystem playgroundSystem null)
|
|
|
|
(defNew [&prop :Archive archive
|
|
&prop :ArchiveUI ui]
|
|
[&mut :Array<Entry> _selectedEntries []
|
|
&mut :ChangeSet lastChangeSet []
|
|
:Map<String,Command> commands (new Map)
|
|
:NameSystem nameSystem (new NameSystem)]
|
|
|
|
(set ui.controller this)
|
|
|
|
// Add systems!
|
|
(archive.addSystem nameSystem)
|
|
(archive.addSystem (new RemarkableAPISystem))
|
|
(archive.addSystem (new WikipediaImageSystem))
|
|
(archive.addSystem (new ImageAttachmentSystem))
|
|
(archive.addSystem (new KeyShortcutSystem this))
|
|
(archive.addSystem (new DLSystem))
|
|
(whenLet [ps (ui.playgroundSystem)]
|
|
(set playgroundSystem ps)
|
|
(archive.addSystem ps)
|
|
(ps.switchPlaygroundKey (dictGet archive.playgrounds "default")))
|
|
|
|
// Just for testing:
|
|
// (archive.addSystem (new AttachmentSystem ["jpg" "jpeg" "png"] ->[archive e files] ~files))
|
|
|
|
(archive.processSystems ui)
|
|
|
|
(defCommand Help []
|
|
(ui.displayMessage
|
|
(+ "Available commands:\n"
|
|
(commandNames.join "\n"))) [])
|
|
|
|
(load "SelectionCommands.kiss")
|
|
|
|
(defCommand Rename [e SelectedEntry newName (Text null)]
|
|
(withWritableComponents archive e [name Name]
|
|
(set name newName))
|
|
[e])
|
|
|
|
(defCommand PrintSelectedEntries [entries (SelectedEntries null null)]
|
|
(doFor e entries (ui.displayMessage (archive.fullString e))) [])
|
|
|
|
(defCommand PrintComponent [entries (SelectedEntries null null)
|
|
componentType (Text null)]
|
|
(doFor e entries
|
|
(if (e.components.exists componentType)
|
|
(ui.displayMessage (dictGet e.components componentType))
|
|
(ui.displayMessage "Entry ${e.id} has no $componentType component"))) [])
|
|
|
|
(defCommand CreateEntry [name (Text null)]
|
|
[(archive.createEntry ->e
|
|
(addComponent archive e Name name))])
|
|
|
|
(defCommand CreateEntries [names (VarText null)]
|
|
// createEntry returns a list, so these lists must be flattened
|
|
(flatten (for name names
|
|
(CreateEntry name))))
|
|
|
|
// TODO use VarTags
|
|
(defCommand CreateTaggedEntry [tags (VarText null) name (Text null)]
|
|
[(archive.createEntry ->e
|
|
{(addComponent archive e Name name)
|
|
(addTags archive e tags)})])
|
|
|
|
// TODO use VarTags
|
|
(defCommand CreateTaggedEntries [tags (VarText null) names (VarText null)]
|
|
// createEntry returns a list, so these lists must be flattened
|
|
(flatten (for name names
|
|
(CreateTaggedEntry tags name))))
|
|
|
|
(defCommand CreateCircleEntry [tags (VarText null) radius (Number 0 null null)]
|
|
[(archive.createEntry ->e
|
|
{(addTags archive e tags)
|
|
(addComponent archive e Circle (objectWith radius))})])
|
|
|
|
// TODO use Tag and VarTag arg types for AddTags and RemoveTags
|
|
(defCommand AddTags [entries (SelectedEntries 1 null)
|
|
tagsToAdd (VarText null)]
|
|
(doFor e entries
|
|
(addTags archive e tagsToAdd))
|
|
entries) // TODO this includes entries that already had the tag in the changeset
|
|
|
|
(defCommand RemoveTags [entries (SelectedEntries 1 null)
|
|
tagsToRemove (VarText null)]
|
|
(doFor e entries
|
|
(removeTags archive e tagsToRemove))
|
|
entries) // TODO this includes entries that didn't have the tag in the changeset
|
|
|
|
(defCommand AddDLURL [e SelectedEntry url (Text null)]
|
|
(addComponent archive e DLURL url))
|
|
|
|
(defCommand AddYoutubeMusic [name (Text null) url (Text null)]
|
|
[(archive.createEntry ->e
|
|
{(addComponent archive e Name name)
|
|
(addTags archive e ["music"])
|
|
(AddDLURL e url)})])
|
|
|
|
(defCommand AddKeyShortcut [e SelectedEntry description (Text null)]
|
|
(addComponent archive e KeyShortcut description))
|
|
|
|
(defCommand AddNATCommand [e (SelectedEntries null null) command (Text null)]
|
|
(doFor e e (addComponent archive e NATCommand command)))
|
|
|
|
(defCommand AddNATCommands [e (SelectedEntries null null) commands (VarText null)]
|
|
(doFor e e (addComponent archive e NATCommands commands)))
|
|
|
|
(defCommand CreateShortcutEntry [description (Text null) command (Text null)]
|
|
[(archive.createEntry ->e {
|
|
(addComponent archive e Name description)
|
|
(AddKeyShortcut e description)
|
|
(AddNATCommand [e] command)})])
|
|
|
|
(defCommand AddFiles [entries (SelectedEntries 1 null)
|
|
// TODO add File and Files as an argument type for commands, ArchiveUI
|
|
// TODO make tkinter file browser externs and use tkinter as the file picking mechanism for CLI
|
|
files (VarText null)]
|
|
(doFor e entries
|
|
(addFiles archive e files))
|
|
entries)
|
|
|
|
(method adjustImagePins [:Array<Entry> entries increment]
|
|
(doFor e entries
|
|
(if (hasComponent e Images2)
|
|
(withWritableComponents archive e [images Images2]
|
|
(set images.pinnedImageIndex (max 0 (min (- images.imageFiles.length 1) (+ increment images.pinnedImageIndex)))))
|
|
(ui.reportError "Entry $e has no Images2 component")))
|
|
entries)
|
|
|
|
(defCommand PinNextImage [entries (SelectedEntries 1 null)]
|
|
(adjustImagePins entries 1))
|
|
|
|
(defCommand PinPreviousImage [entries (SelectedEntries 1 null)]
|
|
(adjustImagePins entries -1))
|
|
|
|
(defCommand SetScale [entries (SelectedEntries 1 null) scale (Number 0 null null)]
|
|
(doFor e entries
|
|
(cond
|
|
((hasComponent e Images2)
|
|
(withWritableComponents archive e [i2 Images2]
|
|
(setNth i2.imageScales i2.pinnedImageIndex scale)))
|
|
((hasComponent e Scale)
|
|
(withWritableComponents archive e [scaleComponent Scale]
|
|
(set scaleComponent scale)))
|
|
(true (addComponent archive e Scale scale))))
|
|
entries)
|
|
|
|
(defCommand CreatePlayground [name (Text null) catsMatchExp (Text null)]
|
|
(archive.changePlaygrounds ->:Void [:DynamicAccess<Dynamic> p]
|
|
(dictSet p name (object catsMatch catsMatchExp)))
|
|
[])
|
|
|
|
(defCommand SwitchPlayground [name (Text null)]
|
|
(archive.changePlaygrounds ->:Void [:DynamicAccess<Dynamic> p] (dictSet p "default" name))
|
|
(when playgroundSystem (playgroundSystem.switchPlaygroundKey name))
|
|
[])
|
|
|
|
(defCommand AddConnections [entries (SelectedEntries 1 null) entriesToConnect (Entries 1 null)]
|
|
(for e entries
|
|
(addConnections archive e entriesToConnect)))
|
|
|
|
(defCommand RemoveConnections [entries (SelectedEntries 1 null) entriesToRemove (Entries 1 null)]
|
|
(for e entries
|
|
(addConnections archive e entriesToRemove)))
|
|
|
|
(defCommand AddColorRGBA [entries (SelectedEntries 1 null) r (Number 0 1 null) g (Number 0 1 null) b (Number 0 1 null) a (Number 0 1 null)]
|
|
(for e entries
|
|
(addColorRGBA archive e r g b a)))
|
|
)
|