kiss-lang/kiss-vscode
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity

chain ktxt2 simple replacements for less latency

Browse Source
This commit is contained in:
Nat Quayle Nelson
2022-05-11 09:50:28 -04:00
parent 919395fabe
commit d85e1061e2
6 changed files with 149 additions and 81 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
projects/kiss-vscode/src/ktxt2/KTxt2.hx
View File

@@ -11,11 +11,11 @@ typedef KTxt2Block = {
source:String,
output:String,
outputLocked:Bool,
// kiss.Stream.Positions:
sourceStart:Position,
sourceEnd:Position,
outputStart:Position,
outputEnd:Position
// absoluteChar ints:
sourceStart:Int,
sourceEnd:Int,
outputStart:Int,
outputEnd:Int
};
typedef KTxt2Comment = {

8
projects/kiss-vscode/src/ktxt2/KTxt2.kiss
View File

@@ -37,10 +37,10 @@
(elements.push (Comment (object text comment start start end end)))))*/
(fileStream.dropChars blockStartEnd.length)
(when (fileStream.isEmpty) (break))
(let [sourceStartPosition (fileStream.position)
(let [sourceStartPosition .absoluteChar (fileStream.position)
sourceBlock (fileStream.expect "A chunk of source text followed by one of $outputStarts"
->(fileStream.takeUntilOneOf outputStarts))
sourceEndPosition (fileStream.position)]
sourceEndPosition .absoluteChar (fileStream.position)]
(set block.source sourceBlock)
(set block.sourceStart sourceStartPosition)
(set block.sourceEnd sourceEndPosition))
@@ -51,10 +51,10 @@
(unlockedStart false)
(otherwise
(throw "Expected one of $outputStarts"))))
(let [outputStartPosition (fileStream.position)
(let [outputStartPosition .absoluteChar (fileStream.position)
outputBlock (fileStream.expect "A chunk of output text followed by $blockStartEnd"
->(fileStream.takeUntilOneOf [blockStartEnd]))
outputEndPosition (fileStream.position)]
outputEndPosition .absoluteChar (fileStream.position)]
(fileStream.dropChars blockStartEnd.length)
(set block.output outputBlock)
(set block.outputStart outputStartPosition)

6
projects/kiss-vscode/src/ktxt2/KTxt2Editor.hx
View File

@@ -15,7 +15,9 @@ using StringTools;
typedef MessageToEditor = {
type:String,
?text:String
?text:String,
?start:Int,
?end:Int
};
typedef EditorState = {
@@ -32,7 +34,7 @@ typedef EditorState = {
showOutputBlocks:Bool
};
typedef EditAction: Void->Void;
typedef EditAction = Void->Void;
typedef Disposable = {
dispose:Void->Void

143
projects/kiss-vscode/src/ktxt2/KTxt2Editor.kiss
View File

@@ -1,9 +1,12 @@
(defMacro printErrors [&body body]
`(try {,@body 0} (catch [e] (print "error $e") 0)))
(var &mut :VSCodeAPI _vscode)
(var &mut :Window window)
(var &mut :Document document)
(var &mut :Element content)
(var &mut :Array<KTxt2Element> ktxt2Elements)
(var &mut :Array<EditAction> editActions)
(var &mut :Int lastEditActionElementIdx -1)
// Because monaco editors are expensive, the editor can't have an infinite number open at a time
(var PAGE_SIZE 24)
@@ -45,6 +48,9 @@
(window.addEventListener "message"
->:Void event
(case (the MessageToEditor event.data)
((objectWith [type "simpleReplaceDone"] text start end)
(changeState s
(set s.text (+ (substr s.text 0 start) text (substr s.text end)))))
((objectWith [type "update"] text)
// Either create the first EditorState, or get the last one
(changeState newState
@@ -123,36 +129,44 @@
}
(window.setTimeout ->(whenMonacoIsAvailable doThis) MONACO_CHECK_MILLI)))
(var &mut :Map<Int,Int> editTimeoutHandles (new Map))
(var EDIT_TIMEOUT_MILLI 4000)
(var &mut :Array<Int> editTimeoutHandle [])
(var EDIT_TIMEOUT_MILLI 2000)
(var EXPORT_TIMEOUT_MILLI 10000)
(var &mut :Array<Int> exportTimeoutHandle [])
(function :Void addEditTimeout [idx :Void->Void handler]
(whenLet [activeTimeoutForIndex (dictGet editTimeoutHandles idx)]
(window.clearTimeout activeTimeoutForIndex))
(whenLet [[activeExportTimeout] exportTimeoutHandle]
(window.clearTimeout activeExportTimeout))
(dictSet editTimeoutHandles
idx
(window.setTimeout
->{
(editTimeoutHandles.remove idx)
(handler)
}
EDIT_TIMEOUT_MILLI))
(set exportTimeoutHandle
[
(window.setTimeout ->{
(set exportTimeoutHandle [])
(export)
}
EXPORT_TIMEOUT_MILLI)
]))
(function :Void skipEditTimeout [idx :Void->Void handler]
(whenLet [activeTimeoutForIndex (dictGet editTimeoutHandles idx)]
(window.clearTimeout activeTimeoutForIndex)
(editTimeoutHandles.remove idx)
(handler)))
(function :Void addEditTimeout [&opt idx :EditAction action]
(printErrors
(localVar &mut thisTimeoutHandle null)
(when idx
(when action
(when (= idx lastEditActionElementIdx)
(whenLet [[activeEditTimeout] editTimeoutHandle]
(set thisTimeoutHandle activeEditTimeout)
(window.clearTimeout activeEditTimeout))))
(set lastEditActionElementIdx idx))
(whenLet [[activeExportTimeout] exportTimeoutHandle]
(window.clearTimeout activeExportTimeout))
(set editTimeoutHandle
[
(window.setTimeout
->(printErrors
(when (= thisTimeoutHandle (first editTimeoutHandle))
(set editTimeoutHandle []))
(when action
(action))
(set lastEditActionElementIdx -1))
EDIT_TIMEOUT_MILLI)
])
(set exportTimeoutHandle
[
(window.setTimeout
->{
(set exportTimeoutHandle [])
(export)
}
EXPORT_TIMEOUT_MILLI)
])))
(var &mut :Dynamic activeEditor)
(var &mut :Array<Dynamic> editors [])
@@ -182,7 +196,6 @@
->editor (addEditTimeout eIdx ->(updateBlock editor))]
(updateSize)
(eventSubscriptions.push (e.onDidFocusEditorText (activateEditor eIdx)))
(eventSubscriptions.push (e.onDidBlurEditorText ->(skipEditTimeout eIdx ->(updateBlock e))))
(eventSubscriptions.push (e.onDidChangeCursorPosition
->evt
(when (Range.isEmpty (activeEditor.getSelection))
@@ -191,8 +204,7 @@
(set s.endCursorPos -1))
// Delay updating the block
(when (dictGet editTimeoutHandles eIdx)
(onChange e)))))
(when editTimeoutHandle (addEditTimeout eIdx)))))
(eventSubscriptions.push (e.onDidChangeCursorSelection
->evt {
(changeState s
@@ -200,8 +212,7 @@
(set s.endCursorPos (.getOffsetAt (e.getModel) (evt.selection.getEndPosition))))
// Delay updating the block
(when (dictGet editTimeoutHandles eIdx)
(onChange e))
(when editTimeoutHandle (addEditTimeout eIdx))
}))
(eventSubscriptions.push (e.onDidBlurEditorText (deactivateEditor eIdx)))
(eventSubscriptions.push (e.onDidContentSizeChange updateSize))
@@ -275,18 +286,60 @@
(s.dropString oldTerminator)
(postMessage (objectWith [type "replace" text terminator end (s.position)] start))))
(function replaceSourceBlock [element idx newText]
(changeState s (set s.sourceBlockChanged idx))
(function blockObj [element]
(case element
((Block (object source text sourceStart start sourceEnd end))
(postMessage (object type "replace" text newText start start end end)))
((Block obj) obj)
(otherwise (throw "element $element is not a block"))))
(function replaceOutputBlock [element newText]
(case element
((Block (object output text outputStart start outputEnd end))
(postMessage (object type "replace" text newText start start end end)))
(otherwise (throw "element $element is not a block"))))
(function updateFollowingBlocks [changingSource idx newText]
(let [element (nth ktxt2Elements idx)
b (blockObj element)
oldText
(if changingSource
b.source
b.output)
deltaLength
(- newText.length oldText.length)]
(if changingSource
{
(set b.source newText)
(+= b.sourceEnd deltaLength)
(+= b.outputStart deltaLength)
(+= b.outputEnd deltaLength)
}
{
(set b.output newText)
(+= b.outputEnd deltaLength)
})
(setNth ktxt2Elements idx (Block b))
(doFor [idx element] (enumerate (ktxt2Elements.slice (+ idx 1)) (+ idx 1))
(let [b (blockObj element)]
(+= b.sourceStart deltaLength)
(+= b.sourceEnd deltaLength)
(+= b.outputStart deltaLength)
(+= b.outputEnd deltaLength)
(setNth ktxt2Elements idx (Block b))))))
(function simpleReplace [text start end]
(printErrors
(postMessage (objectWith [type "simpleReplace"] text start end))))
(function replaceSourceBlock [idx newText]
(let [element (nth ktxt2Elements idx)]
(changeState s (set s.sourceBlockChanged idx))
(case element
((Block (object source text sourceStart start sourceEnd end))
(simpleReplace newText start end))
(otherwise (throw "element $element is not a block")))
(updateFollowingBlocks true idx newText)))
(function replaceOutputBlock [idx newText]
(let [element (nth ktxt2Elements idx)]
(case element
((Block (object output text outputStart start outputEnd end))
(simpleReplace newText start end))
(otherwise (throw "element $element is not a block")))
(updateFollowingBlocks false idx newText)))
(function deleteEntireBlock [element]
(case element
@@ -345,10 +398,10 @@
(content.appendChild (document.createElement "br"))
(when showSourceBlocks (monacoEditor sourceDiv (if showOutputBlocks "width: 50%;" "flex-grow: 1;") source /* TODO get the real extension of the source file: */ "txt" locked
->editor (replaceSourceBlock (nth ktxt2Elements idx) idx (.replace (editor.getValue) "\r" ""))))
->editor (replaceSourceBlock idx (.replace (editor.getValue) "\r" ""))))
(when showOutputBlocks (monacoEditor outputDiv "flex-grow: 1;" output /* TODO get the real extension of the output file: */ "txt" locked
->editor (replaceOutputBlock (nth ktxt2Elements idx) (withOutputTerminator (.replace (editor.getValue) "\r" "")))))
->editor (replaceOutputBlock idx (withOutputTerminator (.replace (editor.getValue) "\r" "")))))
// Link that will delete the whole block:
(set xLink.innerHTML "x")

10
projects/kiss-vscode/src/ktxt2/KTxt2EditorProvider.hx
View File

@@ -14,13 +14,13 @@ using StringTools;
typedef MessageFromEditor = {
type:String,
?text:String,
?start:kiss.Stream.Position,
?end:kiss.Stream.Position,
?position:kiss.Stream.Position,
?start:Int,
?end:Int,
?position:Int,
?source:String,
?output:String,
?outputStart:kiss.Stream.Position,
?outputEnd:kiss.Stream.Position
?outputStart:Int,
?outputEnd:Int
};
@:build(kiss.Kiss.build())

53
projects/kiss-vscode/src/ktxt2/KTxt2EditorProvider.kiss
View File

@@ -15,17 +15,20 @@
(unless (document.getText)
(File.saveContent document.fileName KTxt2.emptyBlock)
**(makeEdit
->edit (edit.insert document.uri (streamPosToDocumentPos (object absoluteChar 0)) KTxt2.emptyBlock)))
->edit (edit.insert document.uri (streamPosToDocumentPos 0) KTxt2.emptyBlock)))
(set webviewPanel.webview.options (object enableScripts true))
(set webviewPanel.webview.html (htmlForWebview webviewPanel.webview))
(let [updateWebview
(let [&mut simpleReplace 0
updateWebview
->(webviewPanel.webview.postMessage (object type "update" text (document.getText)))
changeDocumentSubscription
(Vscode.workspace.onDidChangeTextDocument
->e (when (= (e.document.uri.toString) (document.uri.toString))
(updateWebview)))
streamPosToDocumentPos ->pos (document.positionAt pos.absoluteChar)
streamPosToOffsetDocumentPos ->[pos offset] (document.positionAt (+ offset pos.absoluteChar))
->e (when (and e.contentChanges (= (e.document.uri.toString) (document.uri.toString)))
(if (< 0 simpleReplace)
(-= simpleReplace 1)
{(updateWebview) null})))
streamPosToDocumentPos ->pos (document.positionAt pos)
streamPosToOffsetDocumentPos ->[pos offset] (document.positionAt (+ offset pos))
rangeFromStartEnd ->[start end] (new Range (streamPosToDocumentPos start) (streamPosToDocumentPos end))
makeEdit
->[:WorkspaceEdit->Void builder]
@@ -40,6 +43,15 @@
(case (the MessageFromEditor e)
((object type "print" text message)
(infoMessage message))
// Simple edits to source and output textboxes don't require reloading the HTML structure:
((objectWith [type "simpleReplace"] text start end)
(+= simpleReplace 1)
(awaitLet [result (makeEdit
->edit
(edit.replace document.uri (rangeFromStartEnd start end) (KTxt2.insertSpecialChars text)))]
(if result
{(webviewPanel.webview.postMessage (objectWith [type "simpleReplaceDone"] text start end)) 0}
{**(errorMessage "simpleReplace promise resolved false (which I think means failure)!!") 0})))
((objectWith [type "replace"] text start end)
(makeEdit
->edit (edit.replace document.uri (rangeFromStartEnd start end) (KTxt2.insertSpecialChars text))))
@@ -122,17 +134,18 @@
</html>"))
(function exportSourceAndOutputFiles [document]
(let [:String ktxt2FullFilename document.fileName
ktxt2Directory (ktxt2FullFilename.directory)
ktxt2Filename (ktxt2FullFilename.withoutDirectory)
[baseFilename sourceExt outputExt ktxt2Ext] (ktxt2Filename.split ".")
sourceFilename (joinPath ktxt2Directory "${baseFilename}.${sourceExt}")
outputFilename (joinPath ktxt2Directory "${baseFilename}.${outputExt}")]
(when (= sourceExt outputExt)
(let [m "Source and output extension cannot be the same in $ktxt2Filename"]
(errorMessage m)
(throw m)))
(let [[sourceText outputText] (KTxt2.extractFileContents (Stream.fromFile ktxt2FullFilename) ->message (errorMessage message))]
(File.saveContent sourceFilename sourceText)
(File.saveContent outputFilename outputText)
(print "Export for $(document.fileName.withoutDirectory) succeeded."))))
(try
(let [:String ktxt2FullFilename document.fileName
ktxt2Directory (ktxt2FullFilename.directory)
ktxt2Filename (ktxt2FullFilename.withoutDirectory)
[baseFilename sourceExt outputExt ktxt2Ext] (ktxt2Filename.split ".")
sourceFilename (joinPath ktxt2Directory "${baseFilename}.${sourceExt}")
outputFilename (joinPath ktxt2Directory "${baseFilename}.${outputExt}")]
(when (= sourceExt outputExt)
(let [m "Source and output extension cannot be the same in $ktxt2Filename"]
(errorMessage m)
(throw m)))
(let [[sourceText outputText] (KTxt2.extractFileContents (Stream.fromFile ktxt2FullFilename) ->message (errorMessage message))]
(File.saveContent sourceFilename sourceText)
(File.saveContent outputFilename outputText)) 0)
(catch [e] (errorMessage "Export for $(document.fileName.withoutDirectory) failed: $e") 0)))