text-convert-tool/tct-vscode-editor/src/EditorProvider.kiss

(loadFrom "kiss-vscode-api" "src/Util.kiss")

// Based on https://github.com/microsoft/vscode-extension-samples/blob/main/custom-editor-sample/src/catScratchEditor.ts

(function register [context]
	(set Prelude.printStr ->s (infoMessage s))
    (let [provider (new EditorProvider context)]
        (Vscode.window.registerCustomEditorProvider "tct.splitView" provider)))

(var &mut :String currentFilename null)
(var :Map<String,FileConversionProject> conversionProjects (new Map))
(var :Map<String,Void->Void> fullUpdateFunctions (new Map))
(var &mut :String searchText null)
(var &mut :Null<Int> lastBlockIndex null)

(defNew [&prop :ExtensionContext context])

(method :Promise<Void> resolveCustomTextEditor [:TextDocument document :WebviewPanel webviewPanel :CancellationToken _token]
    (set currentFilename document.fileName)
    (set webviewPanel.webview.options (object enableScripts true))
    (set webviewPanel.webview.html (htmlForWebview webviewPanel.webview))

	(loadFrom "tct" "src/tct/conversions/FountainToHollywoo.kiss")
	(loadFrom "tct" "src/tct/conversions/FountainToHollywooFlixel.kiss")

	(let [loadProject ->(FileConversionProject.loadDirectory (document.fileName.directory))
			&mut project (loadProject)
			postMessage ->[:Message message] (webviewPanel.webview.postMessage (Json.stringify message))
			requestFullUpdate ->:Void {
				(set project (loadProject))
				(postMessage (Initialize project.blocks))
			}
			reportRequest ->:Void [:Bool result] (postMessage (if result RequestSuccess RequestFailure))]
		(localFunction :Void findNext []
			(ifLet [idx (project.findText searchText (+ lastBlockIndex 1))]
					{(set lastBlockIndex idx)
						(postMessage (FoundText idx))}
				{
					(warningMessage "No more occurrences of '${searchText}'")
					// Loop around:
					(unless (= -1 lastBlockIndex)
						(set lastBlockIndex -1)
						(findNext))
				})
			(reportRequest true))
		(localFunction :Void findPrevious []
			(ifLet [idx (project.findLastText searchText (- lastBlockIndex 1))]
					{(set lastBlockIndex idx)
						(postMessage (FoundText idx))}
				{
					(warningMessage "No more occurrences of '${searchText}'")
					// Loop around:
					(unless (= -1 lastBlockIndex)
						(set lastBlockIndex -1)
						(findNext))
				})
			(reportRequest true))
		(localFunction :Void findLineNumber [number output]
			(ifLet [idx (project.findLineNumber number output)]
					(postMessage (FoundText idx))
				(warningMessage "Line number $number not found in $(if output "output file" "input file")"))
			(reportRequest true))

		(prop &mut :Bool lastVisible false)
		(webviewPanel.onDidChangeViewState
			->e {
				(when (and e.webviewPanel.visible !lastVisible) (requestFullUpdate))
				(set lastVisible e.webviewPanel.visible)
			})

		(prop &mut :Bool lastFocused false)
		(Vscode.window.onDidChangeWindowState
			->e {
				(when (and e.focused !lastFocused) (requestFullUpdate))
				(set lastFocused e.focused)
			})

		(dictSet conversionProjects document.fileName project)
		(dictSet fullUpdateFunctions document.fileName requestFullUpdate)
		
		(localFunction :Void chooseConversion [blockIdx]
			(let [validConversions (project.validConversions blockIdx false ->m (errorMessage m))]
				(cond
					((= 1 (count validConversions))
						(let [text (first (collect (validConversions.iterator)))]
							(when (project.editBlock blockIdx null text)
								(postMessage (BlockConverted blockIdx text)))))
					((< 1 (count validConversions))
						// choose between conversions
						(awaitLet [text (_quickPick (for =>key value validConversions (quickPickItem key (Std.string value))))]
							(catch [:Dynamic e]
								(reportRequest false) null)
							(ifLet [_ text
									text (dictGet validConversions text.label)] 
									(when (project.editBlock blockIdx null text)
										(postMessage (BlockConverted blockIdx text)))
								(reportRequest false))
							null))
					(true
						(reportRequest false)))))

		(webviewPanel.webview.onDidReceiveMessage
				->:Void [e]
				 	(let [:Message message (Json.parse e)]
						(case message
							((Print m)
								(print m))
							((Error m)
								(errorMessage m))
							((RequestEdit blockIdx outText value)
								(reportRequest (project.editBlock blockIdx (if outText null value) (if outText value null))))
							((RequestConvert blockIdx)
								(cond
									(.outText (nth project.blocks blockIdx)
										// Check if overwrite?
										(awaitLet [overwrite (quickPick ["Overwrite" "Cancel"])]
											(if (= "Overwrite" overwrite)
											 		(chooseConversion blockIdx)
												(reportRequest false))))
									(true
										(chooseConversion blockIdx))))
							((RequestDelete blockIdx)
								(reportRequest (project.deleteBlock blockIdx)))
							((RequestToggleLock blockIdx)
								(reportRequest (project.toggleLock blockIdx)))
							((RequestInsert blockIdx)
								(reportRequest (project.insertBlock blockIdx)))
							((RequestJoinDown blockIdx)
								(reportRequest (project.joinBlockDown blockIdx)))
							(RequestUndo
								(reportRequest (project.undoChange)))
							(RequestRedo
								(reportRequest (project.redoChange)))
							(RequestFullUpdate
								(requestFullUpdate))
							(RequestFindText
								(awaitLet [text (inputBox)]
									(set searchText text)
									(set lastBlockIndex -1)
									(findNext)))
							(RequestFindNext
								(findNext))
							(RequestFindPrevious
								(findPrevious))
							((RequestLineNumber output)
								(awaitLet [number (inputBox)]
									(findLineNumber (Std.parseInt number) output)))
							((ConfirmManualEdit blockIdx)
								(let [validConversions (project.validConversions blockIdx true ->m (errorMessage m))]
									(cond
										((= 0 (count validConversions))
											(postMessage YesManualEdit))
										(true
											(awaitLet [response (infoMessage "Automatic conversions are available. Really edit manually?" "Yes" "No")]
												(case response
												 	("Yes" (postMessage YesManualEdit))
													("No" (postMessage NoManualEdit))
													(never otherwise)))))))
							(otherwise
								(errorMessage "Unhandled message from editor: $message")))))

		(webviewPanel.onDidChangeViewState
			->e
				(unless e.webviewPanel.visible 
					// Handle editor losing focus
					null))

		(postMessage
			(Initialize project.blocks)))

    null)

(method :String htmlForWebview [:Webview webview]
    (let [monacoDir
				(Uri.joinPath (Uri.parse this.context.extensionUri) "node_modules" "monaco-editor" "min" "vs")
			requireConfigDir
				(webview.asWebviewUri monacoDir)
			cssUri
				(webview.asWebviewUri (Uri.joinPath monacoDir "editor" "editor.main.css"))
			monacoLoaderUri
				(webview.asWebviewUri (Uri.joinPath monacoDir "loader.js"))
			monacoEditorNlsUri
				(webview.asWebviewUri (Uri.joinPath monacoDir "editor" "editor.main.nls.js"))
			monacoEditorUri
				(webview.asWebviewUri (Uri.joinPath monacoDir "editor" "editor.main.js"))
			editorScriptUri
                (webview.asWebviewUri (Uri.joinPath (Uri.parse this.context.extensionUri) "bin" "editor.js"))]
        "<!DOCTYPE html>
			<html>
			<head>
				<meta charset=\"UTF-8\">
				<meta name=\"viewport\" content=\"width=device-width, initial-scale=1.0\">
				<link
					rel=\"stylesheet\"
					data-name=\"vs/editor/editor.main\"
					href=\"${cssUri}\" />
				<style>
					table,
					th,
					td {
						border: 1px solid black;
						border-collapse: collapse;
					}
				</style>
			</head>
			<body>	
				<script src=\"${editorScriptUri}\"></script>
				<script>
					var require = { paths: { vs: \"${requireConfigDir}\" } };
				</script>
				<script src=\"${monacoLoaderUri}\"></script>
				<script src=\"${monacoEditorNlsUri}\"></script>
				<script src=\"${monacoEditorUri}\"></script>
			</body>
			</html>"))