From d85e1061e2e4942f3e6c85376275decee82eb68a Mon Sep 17 00:00:00 2001 From: Nat Quayle Nelson Date: Wed, 11 May 2022 09:50:28 -0400 Subject: [PATCH] chain ktxt2 simple replacements for less latency --- projects/kiss-vscode/src/ktxt2/KTxt2.hx | 10 +- projects/kiss-vscode/src/ktxt2/KTxt2.kiss | 8 +- projects/kiss-vscode/src/ktxt2/KTxt2Editor.hx | 6 +- .../kiss-vscode/src/ktxt2/KTxt2Editor.kiss | 143 ++++++++++++------ .../src/ktxt2/KTxt2EditorProvider.hx | 10 +- .../src/ktxt2/KTxt2EditorProvider.kiss | 53 ++++--- 6 files changed, 149 insertions(+), 81 deletions(-) diff --git a/projects/kiss-vscode/src/ktxt2/KTxt2.hx b/projects/kiss-vscode/src/ktxt2/KTxt2.hx index 3e61e095..6b9e3213 100644 --- a/projects/kiss-vscode/src/ktxt2/KTxt2.hx +++ b/projects/kiss-vscode/src/ktxt2/KTxt2.hx @@ -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 = { diff --git a/projects/kiss-vscode/src/ktxt2/KTxt2.kiss b/projects/kiss-vscode/src/ktxt2/KTxt2.kiss index eb206ad8..536a7f28 100644 --- a/projects/kiss-vscode/src/ktxt2/KTxt2.kiss +++ b/projects/kiss-vscode/src/ktxt2/KTxt2.kiss @@ -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) diff --git a/projects/kiss-vscode/src/ktxt2/KTxt2Editor.hx b/projects/kiss-vscode/src/ktxt2/KTxt2Editor.hx index ea91cb21..7ff7036b 100644 --- a/projects/kiss-vscode/src/ktxt2/KTxt2Editor.hx +++ b/projects/kiss-vscode/src/ktxt2/KTxt2Editor.hx @@ -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 diff --git a/projects/kiss-vscode/src/ktxt2/KTxt2Editor.kiss b/projects/kiss-vscode/src/ktxt2/KTxt2Editor.kiss index 70b07435..c47f8391 100644 --- a/projects/kiss-vscode/src/ktxt2/KTxt2Editor.kiss +++ b/projects/kiss-vscode/src/ktxt2/KTxt2Editor.kiss @@ -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 ktxt2Elements) -(var &mut :Array 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 editTimeoutHandles (new Map)) -(var EDIT_TIMEOUT_MILLI 4000) +(var &mut :Array editTimeoutHandle []) +(var EDIT_TIMEOUT_MILLI 2000) (var EXPORT_TIMEOUT_MILLI 10000) (var &mut :Array 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 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") diff --git a/projects/kiss-vscode/src/ktxt2/KTxt2EditorProvider.hx b/projects/kiss-vscode/src/ktxt2/KTxt2EditorProvider.hx index d68e59fd..bc23c01e 100644 --- a/projects/kiss-vscode/src/ktxt2/KTxt2EditorProvider.hx +++ b/projects/kiss-vscode/src/ktxt2/KTxt2EditorProvider.hx @@ -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()) diff --git a/projects/kiss-vscode/src/ktxt2/KTxt2EditorProvider.kiss b/projects/kiss-vscode/src/ktxt2/KTxt2EditorProvider.kiss index 9490053b..865dc466 100644 --- a/projects/kiss-vscode/src/ktxt2/KTxt2EditorProvider.kiss +++ b/projects/kiss-vscode/src/ktxt2/KTxt2EditorProvider.kiss @@ -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 @@ ")) (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.")))) \ No newline at end of file + (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))) \ No newline at end of file