276 lines
11 KiB
Plaintext
276 lines
11 KiB
Plaintext
/**
|
|
* Aliases
|
|
*/
|
|
|
|
// TODO pass these aliases to the KissState of "eval kiss expression"
|
|
|
|
// output
|
|
(defalias &call infoMessage Vscode.window.showInformationMessage)
|
|
(defalias &call warningMessage Vscode.window.showWarningMessage)
|
|
(defalias &call errorMessage Vscode.window.showErrorMessage)
|
|
|
|
// input
|
|
(defalias &call inputBox Vscode.window.showInputBox)
|
|
(defalias &call quickPick Vscode.window.showQuickPick)
|
|
|
|
// commands
|
|
(defalias &call executeCommand Vscode.commands.executeCommand)
|
|
|
|
// ui
|
|
(defalias &ident activeTextEditor Vscode.window.activeTextEditor)
|
|
|
|
/**
|
|
* Helper functions
|
|
*/
|
|
(function selectedText []
|
|
(if (and activeTextEditor .selection activeTextEditor)
|
|
(let [document
|
|
// TODO should be able to use activeTextEditor.document and have the alias still work
|
|
.document activeTextEditor
|
|
selection
|
|
.selection activeTextEditor
|
|
range (new Range selection.start selection.end)]
|
|
(document.getText range))
|
|
""))
|
|
|
|
// TODO make an async annotation that throws an error if the promise is not wrapped in awaitLet or awaitBegin or returned by an async function?
|
|
// but in some cases it doesn't matter and there are so many edge cases.
|
|
(function insertAt [:vscode.Position pos text]
|
|
(.edit activeTextEditor
|
|
(lambda [e]
|
|
(e.insert pos text))))
|
|
|
|
(function insert [text]
|
|
// TODO this let is because identifier alias dot access is broken:
|
|
(let [editor activeTextEditor]
|
|
(insertAt editor.selection.active text)))
|
|
|
|
/**
|
|
* State
|
|
*/
|
|
|
|
(var :Map<String,Command> commands (new Map))
|
|
(var :Map<String,ShortcutKey> commandShortcuts (new Map))
|
|
|
|
(var &mut :String lastCommand null)
|
|
(var parser (new Parser))
|
|
(var interp (new Interp))
|
|
|
|
/**
|
|
* Functionality
|
|
*/
|
|
|
|
(function :Dynamic evalString [:String kissStr]
|
|
(try
|
|
(interp.execute
|
|
(parser.parseString
|
|
(Prelude.convertToHScript kissStr)))
|
|
(catch [e]
|
|
(errorMessage "Error `${e}` from $kissStr")
|
|
null)))
|
|
|
|
(function :Void evalAndPrint [&opt :String selectedText]
|
|
(if selectedText
|
|
(infoMessage (Std.string (evalString selectedText))))
|
|
|
|
(awaitLet [kissStr (inputBox)]
|
|
(infoMessage (Std.string (evalString kissStr)))))
|
|
|
|
(function :Void runCommand [&opt command] (_runCommand command))
|
|
|
|
(function :Void _runCommand [&opt command inputText]
|
|
(unless inputText (set inputText (selectedText)))
|
|
(if command
|
|
{(set lastCommand command) ((dictGet commands command) inputText)}
|
|
(let [commandList
|
|
(for description (commands.keys)
|
|
(object
|
|
label description
|
|
description null
|
|
detail null
|
|
picked null
|
|
alwaysShow null))]
|
|
(awaitLet [chosenCommand (quickPick commandList)]
|
|
(when chosenCommand
|
|
(set lastCommand chosenCommand.label)
|
|
((dictGet commands chosenCommand.label) inputText))))))
|
|
|
|
(function :Void runLastCommand [&opt _]
|
|
(if lastCommand
|
|
(runCommand lastCommand)
|
|
(errorMessage "No Kiss command was run previously.")))
|
|
|
|
(var &mut :vscode.WebviewPanel shortcutPanel null)
|
|
(function :Void showShortcutPanel [&opt :Map<String,ShortcutKey> prefixMap]
|
|
// Preserve the selected text and focused document before opening the webview:
|
|
(let [inputText (selectedText)]
|
|
// When called without a prefixMap, if a shortcut panel is still open, close it and start over:
|
|
(unless prefixMap
|
|
(when shortcutPanel
|
|
// TODO for some reason, method calling an object in (when [object] ...) context, resets the object's type to Any unless (the [Type]) is used
|
|
(.dispose (the WebviewPanel shortcutPanel))
|
|
(set shortcutPanel null))
|
|
(set prefixMap commandShortcuts))
|
|
(when shortcutPanel (shortcutPanel.dispose))
|
|
(set shortcutPanel (Vscode.window.createWebviewPanel
|
|
"kissShortcut"
|
|
"Kiss Shortcuts"
|
|
vscode.ViewColumn.Two
|
|
(object
|
|
enableScripts true)))
|
|
// The keyListener handler needs to have access to the Disposible object to dispose itself, hence this let/set
|
|
(let [&mut keyListener null]
|
|
(set keyListener (shortcutPanel.webview.onDidReceiveMessage
|
|
->key (if (prefixMap.exists key)
|
|
{(keyListener.dispose)
|
|
(case (dictGet prefixMap key)
|
|
((Prefix innerMap)
|
|
(showShortcutPanel innerMap))
|
|
((Final command)
|
|
(shortcutPanel.dispose)
|
|
// TODO restore focus to previous frame first
|
|
(_runCommand command inputText)))}
|
|
{(warningMessage "$key is not mapped to a shortcut in this context")(return)}))))
|
|
(set shortcutPanel.webview.html (shortcutPanelHtml prefixMap))))
|
|
|
|
(function shortcutPanelHtml [:Map<String,ShortcutKey> prefixMap]
|
|
(let [shortcutParagraphs
|
|
(for =>key shortcutKey prefixMap
|
|
"<p><strong>${key}</strong> - $(case shortcutKey
|
|
((Prefix innerMap)
|
|
"$(Lambda.count innerMap) shortcuts")
|
|
((Final command)
|
|
command))</p>")]
|
|
"<!DOCTYPE html>
|
|
<html lang=\"en\">
|
|
<head>
|
|
<meta charset=\"UTF-8\">
|
|
<meta name=\"viewport\" content=\"width=device-width, initial-scale=1.0\">
|
|
<title>Kiss Shortcuts</title>
|
|
</head>
|
|
<body>
|
|
$(shortcutParagraphs.join "")
|
|
<script>
|
|
const vscode = acquireVsCodeApi();
|
|
window.addEventListener('keydown', function (e) {
|
|
vscode.postMessage(e.key);
|
|
});
|
|
</script>
|
|
</body>
|
|
</html>"))
|
|
|
|
(function :Void runKeyboardShortcut [&opt _]
|
|
(showShortcutPanel))
|
|
|
|
// Extract [k]eyboard [s]hortcuts from a string:
|
|
(function extractKeyboardShortcuts [str &opt :Stream stream :String shortcuts]
|
|
(unless stream (set stream (Stream.fromString str)))
|
|
(unless shortcuts (set shortcuts ""))
|
|
(case (stream.takeUntilAndDrop "[")
|
|
((Some _)
|
|
(case (stream.takeUntilAndDrop "]")
|
|
((Some newShortcuts)
|
|
(extractKeyboardShortcuts str stream (+ shortcuts (newShortcuts.toLowerCase))))
|
|
(None
|
|
(warningMessage "unclosed [ in $str")
|
|
"")))
|
|
(None
|
|
shortcuts)))
|
|
|
|
(function :Void registerShortcut [keys description &opt :Map<String,ShortcutKey> prefixMap]
|
|
(unless prefixMap (set prefixMap commandShortcuts))
|
|
(let [firstKey (keys.shift)]
|
|
(cond
|
|
((prefixMap.exists firstKey)
|
|
(let [existingKey (dictGet prefixMap firstKey)
|
|
conflictMessage "Keyboard shortcut for $description conflicts with $existingKey"]
|
|
(if keys
|
|
// TODO if the existing node is Final, not a branch, throw conflicting message
|
|
(case existingKey
|
|
((Final _)
|
|
(warningMessage conflictMessage))
|
|
((Prefix innerPrefixMap)
|
|
(registerShortcut keys description innerPrefixMap)))
|
|
(warningMessage conflictMessage))))
|
|
(true
|
|
(if keys
|
|
(let [innerPrefixMap (new Map)]
|
|
(dictSet prefixMap firstKey (Prefix innerPrefixMap))
|
|
(registerShortcut keys description innerPrefixMap))
|
|
(dictSet prefixMap firstKey (Final description)))))))
|
|
|
|
(function registerCommand [description command]
|
|
(dictSet commands description command)
|
|
(whenLet [keyboardShortcut (extractKeyboardShortcuts description)]
|
|
(registerShortcut (keyboardShortcut.split "") description)))
|
|
|
|
// Register a VSCode command (built-in, or from an extension)
|
|
(function registerExistingCommand [description command]
|
|
(registerCommand description (lambda :Void [&opt _] (executeCommand command))))
|
|
|
|
(function :Void registerBuiltins []
|
|
(set Prelude.printStr ->:Void s (infoMessage s))
|
|
(registerCommand "Run a [k]iss command" runCommand)
|
|
(registerCommand "Rerun last command" runLastCommand)
|
|
(registerCommand "Run a keyboard shortcut command" runKeyboardShortcut)
|
|
(registerCommand "[e]valuate and print a Kiss expression" evalAndPrint)
|
|
(registerCommand "[n]ew kiss class" newKissClass))
|
|
|
|
// TODO standardize this with KissInterp
|
|
(function :Void prepareInterp []
|
|
(interp.variables.set "kiss"
|
|
(object
|
|
Prelude
|
|
Prelude))
|
|
//interp.variables.set("Helpers", Helpers);
|
|
(interp.variables.set "Prelude" Prelude)
|
|
(interp.variables.set "Lambda" Lambda)
|
|
(interp.variables.set "Vscode" Vscode)
|
|
// TODO for some reason, (interp.variables.set "Std" Std) doesn't capture
|
|
// some static functions, like parseInt. So this kludgy bit is necessary:
|
|
(interp.variables.set "Std"
|
|
(object
|
|
parseInt Std.parseInt
|
|
string Std.string
|
|
random Std.random
|
|
int Std.int)))
|
|
|
|
(defMacro withValueOrInputBox [v &body body]
|
|
`(if ,v
|
|
{,@body}
|
|
(awaitLet [,v (inputBox)]
|
|
,@body)))
|
|
|
|
(function :Void newKissClass [&opt _]
|
|
(awaitLet [className (inputBox)]
|
|
(let [currentFile
|
|
.fileName .document activeTextEditor
|
|
currentFileDirectory
|
|
(Path.directory currentFile)
|
|
haxeFile
|
|
(joinPath currentFileDirectory "${className}.hx")
|
|
kissFile
|
|
(joinPath currentFileDirectory "${className}.kiss")
|
|
// Try to use the same package statement from the first line of the
|
|
// currently open Kiss class's .hx file
|
|
pkg
|
|
(or
|
|
(try
|
|
(let [currentHaxeFile
|
|
(currentFile.withExtension "hx")]
|
|
(first (.split (File.getContent currentHaxeFile) "\n")))
|
|
(catch [e] ""))
|
|
// Default to no specific package declaration
|
|
"package;")]
|
|
(File.saveContent haxeFile
|
|
"${pkg}
|
|
|
|
import kiss.Prelude;
|
|
import kiss.List;
|
|
|
|
@:build(kiss.Kiss.build())
|
|
class ${className} {}
|
|
")
|
|
(File.saveContent kissFile "")
|
|
(Vscode.window.showTextDocument (Uri.file kissFile)))))
|