Started to solve issue IDEMSInternational#8500 allow comments

lloyddewit · Aug 22, 2023 · a15042b · a15042b
1 parent f5ce714
commit a15042b
Show file tree

Hide file tree

Showing 2 changed files with 41 additions and 2 deletions.
diff --git a/instat/clsRLink.vb b/instat/clsRLink.vb
@@ -715,6 +715,45 @@ Public Class RLink
 
     End Function
 
+    Public Sub RunRStatement(strScript As String)
+
+        'if there is no script to run then just ignore and exit sub
+        If String.IsNullOrWhiteSpace(strScript) Then
+            Exit Sub
+        End If
+
+        frmMain.ucrScriptWindow.LogText(strScript.TrimEnd(vbCr, vbLf))
+
+        Try
+            Dim strOutput As String = ""
+            Dim bSuccess As Boolean = Evaluate(strScript, bSilent:=False, bSeparateThread:=False,
+                                               bShowWaitDialogOverride:=Nothing)
+
+            'if not an assignment operation, then capture the output
+            If Not strScript.Contains("<-") AndAlso bSuccess Then
+                Dim strScriptAsSingleLine As String = strScript.Replace(vbCrLf, String.Empty)
+                strScriptAsSingleLine = strScriptAsSingleLine.Replace(vbCr, String.Empty)
+                strScriptAsSingleLine = strScriptAsSingleLine.Replace(vbLf, String.Empty)
+                strOutput = GetFileOutput("view_object_data(object = " & strScriptAsSingleLine &
+                                          " , object_format = 'text' )", bSilent:=False,
+                                          bSeparateThread:=False, bShowWaitDialogOverride:=Nothing)
+            End If
+
+            'log script and output
+            clsOutputLogger.AddOutput(strScript, strOutput, bAsFile:=True,
+                                      bDisplayOutputInExternalViewer:=False)
+
+        Catch e As Exception
+            MsgBox(e.Message & Environment.NewLine &
+                   "The error occurred in attempting to run the following R command:" &
+                   Environment.NewLine & strScript, MsgBoxStyle.Critical,
+                   "Error running R command(s)")
+        End Try
+
+        AppendToAutoSaveLog(strScript)
+        frmMain.UpdateAllGrids()
+    End Sub
+
     '''--------------------------------------------------------------------------------------------
     ''' <summary>
     ''' This method executes the <paramref name="strScript"/> R script(s) and displays the output. The

diff --git a/instat/ucrScript.vb b/instat/ucrScript.vb
@@ -563,12 +563,12 @@ Public Class ucrScript
         'insert carriage return to ensure that statement starts on new line
         'Dim strStatement As String = vbCrLf & rScript.GetCurrentStatement(iCaretPos)
         'Dim iNextStatementPos As Integer = rScript.GetNextStatementPos(iCaretPos)
-        Dim strStatement As String = vbCrLf & clsScriptActive.Lines(clsScriptActive.CurrentLine).Text
+        Dim strStatement As String = clsScriptActive.Lines(clsScriptActive.CurrentLine).Text
         Dim iNextStatementPos As Integer = If(clsScriptActive.CurrentLine = clsScriptActive.Lines.Count - 1,
                 clsScriptActive.TextLength,
                 clsScriptActive.Lines(clsScriptActive.CurrentLine + 1).Position)
 
-        frmMain.clsRLink.RunScript(strStatement.Trim(vbLf), iCallType:=5, strComment:=strComment, bSeparateThread:=False, bSilent:=False)
+        frmMain.clsRLink.RunRStatement(strStatement)
 
         ' if we executed the last statement and there is no blank line after, then add blank line
         If iNextStatementPos >= clsScriptActive.TextLength _